├── .ert-runner ├── .gitignore ├── .travis.yml ├── Cask ├── README.md ├── images └── org-redmine.gif ├── org-redmine.el ├── test.watchr └── test ├── org-redmine-test-fixture.el ├── org-redmine-test.el └── test-helper.el /.ert-runner: -------------------------------------------------------------------------------- 1 | -L . 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.elc 2 | .cask 3 | elpa 4 | 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: emacs-lisp 2 | 3 | branches: 4 | only: 5 | - master 6 | 7 | matrix: 8 | allow_failures: 9 | - env: EMACS=emacs-snapshot EMACS_PPA=ppa:ubuntu-elisp/ppa 10 | 11 | env: 12 | matrix: 13 | - EMACS=emacs24 EMACS_PPA=ppa:cassou/emacs 14 | - EMACS=emacs-snapshot EMACS_PPA=ppa:ubuntu-elisp/ppa 15 | global: 16 | - PATH=$HOME/.cask/bin:$PATH 17 | 18 | before_install: 19 | - sudo add-apt-repository -y "$EMACS_PPA" 20 | - sudo apt-get update -qq 21 | - sudo apt-get install --force-yes -qq "$EMACS" 22 | - sudo apt-get install --force-yes -qq "${EMACS}-el" || true # OK to fail 23 | - curl -fsSkL --max-time 10 --retry 10 --retry-delay 10 https://raw.github.com/cask/cask/master/go | python 24 | - cask install 25 | script: 26 | cask exec ert-runner 27 | -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source gnu) 2 | (source melpa) 3 | 4 | (package-file "org-redmine.el") 5 | 6 | (development 7 | (depends-on "ert") 8 | (depends-on "ert-expectations") 9 | (depends-on "el-mock") 10 | (depends-on "ert-runner") 11 | (depends-on "undercover")) 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | org-redmine 2 | ============================== 3 | 4 | **This repository has been archived because org-redmine is no longer under development.** 5 | 6 | [![Build Status](https://travis-ci.org/gongo/org-redmine.svg?branch=master)](https://travis-ci.org/gongo/org-redmine) 7 | 8 | Overview 9 | -------------------- 10 | 11 | ![](images/org-redmine.gif) 12 | 13 | Install 14 | -------------------- 15 | 16 | ### Using git 17 | 18 | 1. You can clone the git repository 19 | 20 | ``` 21 | $ git clone git://github.com/gongo/org-redmine.git 22 | ``` 23 | 24 | 2. Then add this to your ~/.emacs.el 25 | 26 | ```lisp 27 | (add-to-list 'load-path "/path/to/org-redmine/") 28 | (require 'org-redmine) 29 | ``` 30 | 31 | ### Using auto-install 32 | 33 | ```lisp 34 | ;; Eval this 35 | (auto-install-from-url "https://raw.github.com/gongo/org-redmine/master/org-redmine.el") 36 | 37 | ;; Or run 38 | ;; M-x auto-install-from-url RET https://raw.github.com/gongo/org-redmine/master/org-redmine.el 39 | ``` 40 | 41 | Setup 42 | -------------------- 43 | 44 | ### URL (Required) 45 | 46 | ```lisp 47 | ;; Target Redmine URI 48 | ;; eg. Redmine Project 49 | (setq org-redmine-uri "http://www.redmine.org") 50 | ;; eg. Ruby Project 51 | (setq org-redmine-uri "http://redmine.ruby-lang.org") 52 | ``` 53 | 54 | ### Authentication (Optional) 55 | 56 | Presented in order of highest priority setting. 57 | 58 | 1. REST API Key 59 | 60 | ```lisp 61 | (setq org-redmine-auth-api-key "xxxxxxxxxxxxxxxxxxxx") ;; nil default 62 | ``` 63 | 64 | 2. username/password 65 | 66 | ```lisp 67 | (setq org-redmine-auth-username "gongo") 68 | (setq org-redmine-auth-password "secret") 69 | ``` 70 | 71 | 3. use `$HOME/.netrc` 72 | 73 | ```lisp 74 | ;; if t, read $HOME/.netrc 75 | (setq org-redmine-auth-netrc-use t) ;; nil default 76 | ``` 77 | 78 | ### Template Sequences 79 | 80 | | %-sequence | mean | 81 | |------------|--------------------| 82 | | `%as_i%` | assigned_to id | 83 | | `%as_n%` | assigned_to name | 84 | | `%au_i%` | author id | 85 | | `%au_n%` | author name | 86 | | `%c_i%` | category id | 87 | | `%c_n%` | category name | 88 | | `%c_date%` | created_on | 89 | | `%d%` | description | 90 | | `%done%` | done_ratio | 91 | | `%d_date%` | due_date | 92 | | `%i%` | issue id | 93 | | `%pr_i%` | priority id | 94 | | `%pr_n%` | priority name | 95 | | `%p_i%` | project id | 96 | | `%p_n%` | project name | 97 | | `%s_date%` | start_date | 98 | | `%s_i%` | status id | 99 | | `%s_n%` | status name | 100 | | `%s%` | subject | 101 | | `%t_i%` | tracker id | 102 | | `%t_n%` | tracker name | 103 | | `%u_date%` | updated_on | 104 | | `%v_n%` | fixed_version name | 105 | | `%v_i%` | fixed_version id | 106 | 107 | ### Template of insert subtree 108 | 109 | ```lisp 110 | ;; default template 111 | ;; (defvar org-redmine-template-header "#%i% %s% :%t_n%:") 112 | ;; (defvar org-redmine-template-property nil) 113 | 114 | ;; * [#333] Subject :Tag: 115 | 116 | (setq org-redmine-template-header "[%p_n%] #%i% %s% by %as_n%") 117 | (setq org-redmine-template-property 118 | '(("assigned_to" . "%as_n%") 119 | ("version" . "%v_n%"))) 120 | 121 | ;; * [ProjectName] #333 Subject by gongo 122 | ;; :PROPERTIES: 123 | ;; :assigned_to: dududu 124 | ;; :version: 1.2 125 | ;; :END: 126 | 127 | (setq org-redmine-template-header "[#%i%] %s%") 128 | (setq org-redmine-template-property 129 | '(("project_name" . "%p_n%"))) 130 | 131 | ;; * [#333] Subject 132 | ;; :PROPERTIES: 133 | ;; :project_name: ProjectName 134 | ;; :END: 135 | ``` 136 | 137 | See org-redmine.el for other % sequence list 138 | 139 | LICENSE 140 | -------------------- 141 | 142 | MIT 143 | -------------------------------------------------------------------------------- /images/org-redmine.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/emacsorphanage/org-redmine/7f1cfa0cc4e6eeb076607f501868a7f5690461f4/images/org-redmine.gif -------------------------------------------------------------------------------- /org-redmine.el: -------------------------------------------------------------------------------- 1 | ;;; org-redmine.el --- Redmine tools using Emacs OrgMode 2 | 3 | ;; Author: Wataru MIYAGUNI 4 | ;; URL: https://github.com/gongo/org-redmine 5 | ;; Keywords: redmine org 6 | ;; Version: 0.1.0 7 | 8 | ;; Copyright (c) 2015 Wataru MIYAGUNI 9 | ;; 10 | ;; MIT License 11 | ;; 12 | ;; Permission is hereby granted, free of charge, to any person obtaining 13 | ;; a copy of this software and associated documentation files (the 14 | ;; "Software"), to deal in the Software without restriction, including 15 | ;; without limitation the rights to use, copy, modify, merge, publish, 16 | ;; distribute, sublicense, and/or sell copies of the Software, and to 17 | ;; permit persons to whom the Software is furnished to do so, subject to 18 | ;; the following conditions: 19 | ;; 20 | ;; The above copyright notice and this permission notice shall be 21 | ;; included in all copies or substantial portions of the Software. 22 | ;; 23 | ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 24 | ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 25 | ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 26 | ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 27 | ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 28 | ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 29 | ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 30 | 31 | ;;; Commentary: 32 | 33 | ;; This program is a client for Redmine using `org-mode'. 34 | ;; In the Emacs, uses can show list of issue (responsible, recent, all, etc..). 35 | 36 | ;;; Code: 37 | 38 | (eval-when-compile 39 | (require 'cl)) 40 | (require 'org) 41 | (require 'json) 42 | 43 | (declare-function helm "helm") 44 | (declare-function helm-make-source "helm-source") 45 | (declare-function anything "anything") 46 | 47 | (defconst org-redmine-config-default-limit 25 48 | "Default value the number of items to be present in the response. 49 | default is 25, maximum is 100. 50 | 51 | see http://www.redmine.org/projects/redmine/wiki/Rest_api#Collection-resources-and-pagination") 52 | 53 | (defconst org-redmine-property-id-name "issue_id") 54 | (defconst org-redmine-property-updated-name "updated_on") 55 | (defconst org-redmine-template-header-default "#%i% %s% :%t_n%:") 56 | (defconst org-redmine-template-%-sequences 57 | '(("%as_i%" "assigned_to" "id") 58 | ("%as_n%" "assigned_to" "name") 59 | ("%au_i%" "author" "id") 60 | ("%au_n%" "author" "name") 61 | ("%c_i%" "category" "id") 62 | ("%c_n%" "category" "name") 63 | ("%c_date%" "created_on") 64 | ("%d%" "description") 65 | ("%done%" "done_ratio") 66 | ("%d_date%" "due_date") 67 | ("%i%" "id") 68 | ("%pr_i%" "priority" "id") 69 | ("%pr_n%" "priority" "name") 70 | ("%p_i%" "project" "id") 71 | ("%p_n%" "project" "name") 72 | ("%s_date%" "start_date") 73 | ("%s_i%" "status" "id") 74 | ("%s_n%" "status" "name") 75 | ("%s%" "subject") 76 | ("%t_i%" "tracker" "id") 77 | ("%t_n%" "tracker" "name") 78 | ("%u_date%" "updated_on") 79 | ("%v_n%" "fixed_version" "name") 80 | ("%v_i%" "fixed_version" "id"))) 81 | 82 | 83 | (defvar org-redmine-uri "http://redmine120.dev" 84 | "Target Redmine URI") 85 | 86 | (defvar org-redmine-auth-api-key nil) 87 | (defvar org-redmine-auth-username nil) 88 | (defvar org-redmine-auth-password nil) 89 | (defvar org-redmine-auth-netrc-use nil) 90 | 91 | (defvar org-redmine-limit org-redmine-config-default-limit 92 | "The number of items to be present in the response.") 93 | (defvar org-redmine-curl-buffer "*Org redmine curl buffer*" 94 | "Buffer curl output") 95 | (defvar org-redmine-template-header nil 96 | "") 97 | (defvar org-redmine-template-property-use t 98 | "Whether to insert properties") 99 | (defvar org-redmine-template-property nil 100 | "") 101 | (defvar org-redmine-template-anything-source "#%i% [%p_n%] %s% / %as_n%") 102 | (defvar org-redmine-template-set 103 | '(nil 104 | nil 105 | "%d")) 106 | 107 | ;;------------------------------ 108 | ;; org-redmine error signals 109 | ;;------------------------------ 110 | (put 'org-redmine-exception-not-retrieved 'error-message "OrgRedmine - Not retrieved") 111 | (put 'org-redmine-exception-not-retrieved 'error-conditions '(org-redmine-exception-not-retrieved error)) 112 | (put 'org-redmine-exception-no-date-format 'error-message "OrgRedmine - No date format") 113 | (put 'org-redmine-exception-no-date-format 'error-conditions '(org-redmine-exception-no-date-format error)) 114 | 115 | ;;------------------------------ 116 | ;; org-redmine utility functions 117 | ;;------------------------------ 118 | (defun orutil-join (list &optional sep func) 119 | "Join list with a string 120 | 121 | Example: 122 | (orutil-join '(\"a\" \"b\" \"c\")) 123 | ;; => \"a,b,c\" 124 | (orutil-join '(\"a\" \"b\" \"c\") \"-\") 125 | ;; => \"a-b-c\" 126 | (orutil-join '(3 \"2\" 1) \"%\") 127 | ;; => \"3%2%1\" 128 | (orutil-join '(3 2 1) \"/\" '(lambda (x) (number-to-string (* x 2)))) 129 | ;; => \"6/4/2\" 130 | " 131 | (mapconcat (lambda (x) (if func (funcall func x) 132 | (format "%s" x))) list (or sep ","))) 133 | 134 | (defun orutil-http-query (alist) 135 | (orutil-join alist "&" 136 | (lambda (x) 137 | (format "%s=%s" 138 | (url-hexify-string (car x)) 139 | (url-hexify-string (cdr x)))))) 140 | 141 | (defun orutil-gethash (table k &rest keys) 142 | "Execute `gethash' recursive to TABLE. 143 | 144 | Example: 145 | hashtable = { 146 | \"a\" : 3 , 147 | \"b\" : { 148 | \"c\" : \"12\", 149 | \"d\" : { \"e\" : \"31\" } 150 | } 151 | } ;; => pseudo hash table like json format 152 | (orutil-gethash hashtable \"a\") 153 | ;; => 3 154 | (orutil-gethash hashtable \"b\") 155 | ;; => { \"c\" : \"12\", \"d\" : { \"e\" : \"31\" } } 156 | (orutil-gethash hashtable \"b\" \"c\") 157 | ;; => \"12\" 158 | (orutil-gethash hashtable \"b\" \"d\" \"e\") 159 | ;; => \"31\" 160 | (orutil-gethash hashtable \"b\" \"a\") 161 | ;; => nil 162 | (orutil-gethash hashtable \"a\" \"c\") 163 | ;; => nil 164 | " 165 | (save-match-data 166 | (let ((ret (gethash k table))) 167 | (while (and keys ret) 168 | (if (hash-table-p ret) 169 | (progn 170 | (setq ret (gethash (car keys) ret)) 171 | (setq keys (cdr keys))) 172 | (setq ret nil))) 173 | ret))) 174 | 175 | (defun orutil-date-to-float (s) 176 | "Transform date format string to float. 177 | 178 | Format is 179 | %Y/%m/%d %H:%M:%S (+|-)%z 180 | ;; eg. 2011/07/06 21:22:01 +0900 181 | 182 | Example. 183 | 184 | (orutil-date-to-float \"2011/07/06 21:22:01 +0900\") 185 | ;; => 1309954921.0 186 | 187 | (orutil-date-to-float \"2011/07/06 2a:22:01 ?0900\") 188 | ;; => nil 189 | " 190 | (unless (string-match "^\\([0-9]+\\)/\\([0-9]+\\)/\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) \\([+\\-]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)$" s) 191 | (signal 'org-redmine-exception-no-date-format "No date format")) 192 | (let ((year (string-to-number (match-string 1 s))) 193 | (month (string-to-number (match-string 2 s))) 194 | (day (string-to-number (match-string 3 s))) 195 | (hour (string-to-number (match-string 4 s))) 196 | (minutes (string-to-number (match-string 5 s))) 197 | (seconds (string-to-number (match-string 6 s))) 198 | (zone-sign (string-to-number (match-string 7 s))) 199 | (zone-hour (string-to-number (match-string 8 s))) 200 | (zone-minutes (string-to-number (match-string 9 s))) 201 | zone) 202 | (setq zone (* (if (eq zone-sign "-") -1 1) 203 | (+ zone-minutes (* 3600 zone-hour)))) 204 | (float-time (encode-time seconds minutes hour day month year nil nil zone)))) 205 | 206 | (defun orutil-date-cmp (date1 date2) 207 | "Return t if DATE1 is before DATE2, nil otherwise. 208 | 209 | DATE1 and DATE2 formatted defined by `orutil-date-to-float' 210 | 211 | Example. 212 | 213 | (orutil-date-cmp \"2011/07/06 21:22:01 +0900\" \"2011/07/07 21:22:01 +0900\") 214 | ;; => t 215 | 216 | (orutil-date-cmp \"2011/07/06 21:22:01 +0900\" \"2011/07/06 21:22:01 +0800\") 217 | ;; => t 218 | " 219 | (< (orutil-date-to-float date1) (orutil-date-to-float date2))) 220 | 221 | (defun orutil-format-with-issue (fstr issue) 222 | "Format a string out of a format string and issue attribute hash" 223 | (with-temp-buffer 224 | (erase-buffer) 225 | (insert fstr) 226 | (goto-char (point-min)) 227 | (while (re-search-forward "\\(%[a-z_]+%\\)" nil t) 228 | (let ((attr (org-redmine-template-%-to-attrkey (match-string 1)))) 229 | (if attr (replace-match (org-redmine-issue-attrvalue issue attr) t t)))) 230 | (buffer-string))) 231 | 232 | (defun orutil-print-error (msg) 233 | (message msg) 234 | (list msg)) 235 | 236 | ;;------------------------------ 237 | ;; org-redmine connection functions 238 | ;;------------------------------ 239 | (defun org-redmine-curl-get (uri) 240 | "" 241 | (ignore-errors (kill-buffer org-redmine-curl-buffer)) 242 | (unless (eq 0 (apply 'call-process "curl" nil `(,org-redmine-curl-buffer nil) nil 243 | (org-redmine-curl-args uri) 244 | )) 245 | (signal 'org-redmine-exception-not-retrieved "The requested URL returned error")) 246 | (save-current-buffer 247 | (set-buffer org-redmine-curl-buffer) 248 | (let ((json-object-type 'hash-table) 249 | (json-array-type 'list)) 250 | (condition-case err 251 | (json-read-from-string (buffer-string)) 252 | (json-readtable-error 253 | (message "%s: Non JSON data because of a server side exception. See %s" 254 | (error-message-string err) org-redmine-curl-buffer)))))) 255 | 256 | (defun org-redmine-curl-args (uri) 257 | (let ((args '("-X" "GET" "-s" "-f"))) 258 | (append 259 | args 260 | (cond (org-redmine-auth-api-key 261 | `("-G" "-d" 262 | ,(format "key=%s" org-redmine-auth-api-key))) 263 | (org-redmine-auth-username 264 | `("-u" 265 | ,(format "%s:%s" 266 | org-redmine-auth-username (or org-redmine-auth-password "")))) 267 | (org-redmine-auth-netrc-use '("--netrc")) 268 | (t "")) 269 | `(,uri)))) 270 | 271 | ;;------------------------------ 272 | ;; org-redmine template functions 273 | ;;------------------------------ 274 | (defun org-redmine-template-%-to-attrkey (sequence) 275 | "Transform %-sequence to issue attribute list (see `org-redmine-template-%-sequences'). 276 | 277 | Example. 278 | (setq org-redmine-template-%-sequences 279 | '((\"%as_i%\" \"assigned_to\" \"id\") 280 | (\"%s%\" \"subject\") 281 | (\"%au_n%\" \"author\" \"name\"))) 282 | 283 | (org-redmine-template-%-to-attrkey \"%as_i%\") ;; => '(\"assigned_to\" \"id\") 284 | (org-redmine-template-%-to-attrkey \"%s%\") ;; => '(\"subject\") 285 | " 286 | (cdr (assoc sequence org-redmine-template-%-sequences))) 287 | 288 | ;;------------------------------ 289 | ;; org-redmine issue function 290 | ;;------------------------------ 291 | (defun org-redmine-issue-attrvalue (issue attrkey) 292 | "Get attribute value for ATTRKEY of ISSUE 293 | 294 | Example: 295 | issue = { 296 | \"subject\" : \"Subject\", 297 | \"project\" : { 298 | \"id\" : 1, 299 | \"name\" : \"PrijectName\" 300 | } 301 | } ;; => pseudo issue like json format 302 | 303 | (org-redmine-issue-attrvalue issue '(\"subject\")) ;; => \"Subject\" 304 | (org-redmine-issue-attrvalue issue '(\"project\" \"id\")) ;; => 1 305 | " 306 | (format "%s" (apply 'orutil-gethash issue attrkey))) 307 | 308 | (defun org-redmine-issue-attrvalue-from-% (issue seq) 309 | "Get attribute value of ISSUE using %-sequence SEQ 310 | 311 | Example: 312 | issue = { 313 | \"subject\" : \"Subject\", 314 | \"project\" : { 315 | \"id\" : 1, 316 | \"name\" : \"PrijectName\" 317 | } 318 | } ;; => pseudo issue like json format 319 | 320 | (setq org-redmine-template-%-sequences 321 | '((\"%p_i%\" \"project\" \"id\") 322 | (\"%p_i%\" \"project\" \"name\") 323 | (\"%s%\" \"subject\"))) 324 | 325 | (org-redmine-issue-attrvalue issue \"%s%\")) ;; => \"Subject\" 326 | (org-redmine-issue-attrvalue issue \"%p_i%\")) ;; => 1 327 | " 328 | (org-redmine-issue-attrvalue issue (org-redmine-template-%-to-attrkey seq))) 329 | 330 | 331 | (defun org-redmine-issue-uri (issue) 332 | "Return uri of ISSUE with `org-redmine-uri'. 333 | 334 | Example. 335 | (setq org-redmine-uri \"http://redmine.org\") 336 | (org-redmine-issue-uri issue) ;; => \"http://redmine.org/issues/1\" 337 | 338 | (setq org-redmine-uri \"http://localhost/redmine\") 339 | (org-redmine-issue-uri issue) ;; => \"http://localhost/redmine/issues/1\"" 340 | (format "%s/issues/%s" org-redmine-uri (orutil-gethash issue "id"))) 341 | 342 | ;;------------------------------ 343 | ;; org-redmine entry function 344 | ;;------------------------------ 345 | (defun org-redmine-entry-get-update-info () 346 | "Get property values that necessary to issue update. 347 | 348 | Return cons (issue_id . updated_on)" 349 | (let ((properties (org-entry-properties))) 350 | (cons 351 | (cdr (assoc org-redmine-property-id-name properties)) 352 | (cdr (assoc org-redmine-property-updated-name properties))))) 353 | 354 | 355 | ;;------------------------------ 356 | ;; org-redmine buffer function 357 | ;;------------------------------ 358 | (defun org-redmine-insert-header (issue level) 359 | "" 360 | (let ((template (or org-redmine-template-header 361 | (nth 0 org-redmine-template-set) 362 | org-redmine-template-header-default)) 363 | (stars (make-string level ?*))) 364 | (insert 365 | (concat stars " " (orutil-format-with-issue template issue))))) 366 | 367 | (defun* org-redmine-insert-property (issue) 368 | "" 369 | (unless org-redmine-template-property-use 370 | (return-from org-redmine-insert-property)) 371 | (let* ((properties (or org-redmine-template-property 372 | (nth 1 org-redmine-template-set) 373 | '())) 374 | property key value) 375 | (org-set-property org-redmine-property-id-name (int-to-string (orutil-gethash issue "id"))) 376 | (org-set-property org-redmine-property-updated-name (orutil-gethash issue "updated_on")) 377 | (while properties 378 | (setq property (car properties)) 379 | (org-set-property (car property) 380 | (org-redmine-issue-attrvalue-from-% issue (cdr property))) 381 | (setq properties (cdr properties))) 382 | )) 383 | 384 | (defun org-redmine-escaped-% () 385 | "Check if % was escaped - if yes, unescape it now." 386 | (if (equal (char-before (match-beginning 0)) ?\\) 387 | (progn 388 | (delete-region (1- (match-beginning 0)) (match-beginning 0)) 389 | t) 390 | nil)) 391 | 392 | (defun org-redmine-insert-subtree (issue) 393 | "" 394 | (if (hash-table-p issue) 395 | (let ((level (or (org-current-level) 1))) 396 | (outline-next-visible-heading 1) 397 | (org-redmine-insert-header issue level) 398 | (insert "\n") 399 | (outline-previous-visible-heading 1) 400 | (org-redmine-insert-property issue)))) 401 | 402 | ;;------------------------------ 403 | ;; org-redmine sources for user function 404 | ;;------------------------------ 405 | (defun org-redmine-get-issue-all (me) 406 | "Return the recent issues (list of hash-table). 407 | When error occurs, return list of error message. 408 | 409 | if ME is t, return issues are assigned to user. 410 | " 411 | (let ((querylist (list (cons "limit" (org-redmine-config-get-limit t)))) 412 | query issue-all) 413 | 414 | (condition-case err 415 | (progn 416 | (if me (add-to-list 'querylist (cons "assigned_to_id" "me"))) 417 | (setq query (orutil-http-query querylist)) 418 | (setq issue-all (org-redmine-curl-get 419 | (concat org-redmine-uri "/issues.json?" query))) 420 | (orutil-gethash issue-all "issues")) 421 | (org-redmine-exception-not-retrieved 422 | (orutil-print-error (format "%s: Can't get issues on %s" 423 | (error-message-string err) org-redmine-uri)))))) 424 | 425 | (defun org-redmine-transformer-issues-source (issues) 426 | "Transform issues to `anything' source. 427 | 428 | First, string that combined issue id, project name, subject, and member assinged to issue. 429 | Second, issue (hash table). 430 | 431 | Example. 432 | (setq issues '(issue1 issue2 issue3)) ;; => issue[1-3] is hash table 433 | (org-redmine-transformer-issues-source issues) 434 | ;; => '((issue1-string . issue1) (issue2-string . issue2) (issue3-string . issue3)) 435 | " 436 | (mapcar 437 | (lambda (issue) 438 | (cond ((stringp issue) 439 | (cons issue nil)) 440 | ((hash-table-p issue) 441 | (cons (orutil-format-with-issue org-redmine-template-anything-source 442 | issue) 443 | issue)))) 444 | issues)) 445 | 446 | ;;------------------------------ 447 | ;; org-redmine config function 448 | ;;------------------------------ 449 | (defun org-redmine-config-get-limit (&optional toStr) 450 | (let ((limit org-redmine-limit)) 451 | (if (integerp limit) 452 | (when (or (< limit 1) (> limit 100)) 453 | (message (format "Warning: org-redmine-limit is out of range. return default value %s" 454 | org-redmine-config-default-limit)) 455 | (setq limit org-redmine-config-default-limit)) 456 | (progn 457 | (message (format "Warning: org-redmine-limit isn't integer. return default value %s" 458 | org-redmine-config-default-limit)) 459 | (setq limit org-redmine-config-default-limit))) 460 | (if toStr (int-to-string limit) limit))) 461 | 462 | ;;------------------------------ 463 | ;; org-redmine user function 464 | ;;------------------------------ 465 | ;;;###autoload 466 | (defun org-redmine-get-issue (issue-id) 467 | "" 468 | (interactive "sIssue ID: ") 469 | (let (issue) 470 | (condition-case err 471 | (progn 472 | (setq issue (org-redmine-curl-get 473 | (format "%s/issues/%s.json" org-redmine-uri issue-id))) 474 | (org-redmine-insert-subtree (orutil-gethash issue "issue"))) 475 | (org-redmine-exception-not-retrieved 476 | (orutil-print-error 477 | (format "%s: Can't find issue #%s on %s" 478 | (error-message-string err) issue-id org-redmine-uri)))))) 479 | 480 | ;;;###autoload 481 | (defun org-redmine-anything-show-issue-all (&optional me) 482 | "Display recent issues using `anything'" 483 | (interactive "P") 484 | (if (require 'anything nil t) 485 | (anything 486 | `(((name . "Issues") 487 | (candidates . ,(org-redmine-get-issue-all me)) 488 | (candidate-transformer . org-redmine-transformer-issues-source) 489 | (volatile) 490 | (action . (("Open Browser" 491 | . (lambda (issue) (browse-url (org-redmine-issue-uri issue)))) 492 | ("Insert Subtree" 493 | . (lambda (issue) (org-redmine-insert-subtree issue)))))))) 494 | (message "`anything` is not available. Please install it."))) 495 | 496 | ;;;###autoload 497 | (defun org-redmine-helm-show-issue-all (&optional me) 498 | "Display recent issues using `helm'" 499 | (interactive "P") 500 | (if (require 'helm nil t) 501 | (helm :sources (helm-make-source "Issues" 'helm-source-sync 502 | :candidates (lambda () (org-redmine-get-issue-all me)) 503 | :candidate-transformer '(org-redmine-transformer-issues-source) 504 | :volatile t 505 | :action '(("Open Browser" 506 | . (lambda (issue) (browse-url (org-redmine-issue-uri issue)))) 507 | ("Insert Subtree" 508 | . (lambda (issue) (org-redmine-insert-subtree issue)))))) 509 | (message "`helm` is not available. Please install it."))) 510 | 511 | (provide 'org-redmine) 512 | 513 | ;;; org-redmine.el ends here 514 | -------------------------------------------------------------------------------- /test.watchr: -------------------------------------------------------------------------------- 1 | def run_test 2 | system 'make test' 3 | end 4 | 5 | watch('org-redmine.el') { |m| run_test } 6 | watch('test/org-redmine-test.el') { |m| run_test } 7 | -------------------------------------------------------------------------------- /test/org-redmine-test-fixture.el: -------------------------------------------------------------------------------- 1 | (setq json-object-type 'hash-table) 2 | (setq json-array-type 'list) 3 | 4 | (setq fixture-issue-json 5 | (json-read-from-string "{\"issue\":{ 6 | \"updated_on\":\"2011/07/06 21:27:04 +0900\", 7 | \"category\":{\"name\":\"バージョン 0.3\",\"id\":1}, 8 | \"status\":{\"name\":\"新規\",\"id\":1}, 9 | \"subject\":\"軌跡検知\", 10 | \"project\":{\"name\":\"肉体言語 Tython\",\"id\":1}, 11 | \"tracker\":{\"name\":\"機能\",\"id\":2}, 12 | \"spent_hours\":0.0, 13 | \"assigned_to\":{\"name\":\"Wataru MIYAGUNI\",\"id\":3}, 14 | \"start_date\":\"2011/07/06\", 15 | \"created_on\":\"2011/07/06 21:22:01 +0900\", 16 | \"done_ratio\":0, 17 | \"description\":\"軌跡検知を実装する\", 18 | \"author\":{\"name\":\"Wataru MIYAGUNI\",\"id\":3}, 19 | \"id\":1, 20 | \"priority\":{\"name\":\"通常\",\"id\":4} 21 | }}")) 22 | 23 | (setq fixture-issue-all-json 24 | (json-read-from-string "\ 25 | {\"offset\":0,\"total_count\":3,\"limit\":25, 26 | \"issues\":[ 27 | { 28 | \"updated_on\":\"2011/07/07 23:01:48 +0900\", 29 | \"status\":{\"name\":\"進行中\",\"id\":2}, 30 | \"subject\":\"サマーソルトキックを認識\", 31 | \"project\":{\"name\":\"肉体言語 Tython\",\"id\":1}, 32 | \"tracker\":{\"name\":\"機能\",\"id\":2}, 33 | \"assigned_to\":{\"name\":\"Wataru MIYAGUNI\",\"id\":3}, 34 | \"start_date\":\"2011/07/07\", 35 | \"created_on\":\"2011/07/07 22:57:00 +0900\", 36 | \"done_ratio\":40, 37 | \"description\":\"めんどくさい\", 38 | \"due_date\":\"2011/07/20\", 39 | \"author\":{\"name\":\"Wataru MIYAGUNI\",\"id\":3}, 40 | \"id\":3, 41 | \"priority\":{\"name\":\"\u901a\u5e38\",\"id\":4} 42 | }, 43 | { 44 | \"updated_on\":\"2011/07/07 22:55:15 +0900\", 45 | \"status\":{\"name\":\"新規\",\"id\":1}, 46 | \"subject\":\"走る\", 47 | \"project\":{\"name\":\"Gongo Kinect Diet\",\"id\":2}, 48 | \"tracker\":{\"name\":\"\u904b\u52d5\",\"id\":4}, 49 | \"start_date\":\"2011/07/07\", 50 | \"created_on\":\"2011/07/07 22:54:07 +0900\", 51 | \"done_ratio\":0, 52 | \"description\":\"走れ\", 53 | \"custom_fields\":[{\"value\":\"320\",\"name\":\"\u6d88\u8cbb\u30ab\u30ed\u30ea\u30fc\",\"id\":1}], 54 | \"fixed_version\":{\"name\":\"90kg代\",\"id\":1}, 55 | \"author\":{\"name\":\"Wataru MIYAGUNI\",\"id\":3}, 56 | \"id\":2, 57 | \"priority\":{\"name\":\"\u901a\u5e38\",\"id\":4} 58 | }, 59 | { 60 | \"updated_on\":\"2011/07/07 23:01:28 +0900\", 61 | \"category\":{\"name\":\"0.3\",\"id\":1}, 62 | \"status\":{\"name\":\"解決\",\"id\":3}, 63 | \"subject\":\"軌跡検知\", 64 | \"project\":{\"name\":\"肉体言語 Tython\",\"id\":1}, 65 | \"tracker\":{\"name\":\"機能\",\"id\":2}, 66 | \"assigned_to\":{\"name\":\"Wataru MIYAGUNI\",\"id\":3}, 67 | \"start_date\":\"2011/07/06\", 68 | \"created_on\":\"2011/07/06 21:22:01 +0900\", 69 | \"done_ratio\":100, 70 | \"description\":\"軌跡検知を実装する\", 71 | \"author\":{\"name\":\"Wataru MIYAGUNI\",\"id\":3}, 72 | \"id\":1, 73 | \"priority\":{\"name\":\"\u901a\u5e38\",\"id\":4} 74 | } 75 | ] 76 | }")) 77 | 78 | (setq hash-json 79 | (json-read-from-string "{\"a\":3, \"b\":{ \"c\":\"12\", \"d\":{ \"e\":\"31\" } } }")) 80 | 81 | (setq fixture-issue (gethash "issue" fixture-issue-json)) 82 | (setq fixture-issue-all (gethash "issues" fixture-issue-all-json)) 83 | 84 | (provide 'org-redmine-test-fixture) 85 | -------------------------------------------------------------------------------- /test/org-redmine-test.el: -------------------------------------------------------------------------------- 1 | (if noninteractive 2 | (load-file (concat (file-name-directory load-file-name) "org-redmine-test-fixture.el")) 3 | (load-file "org-redmine-test-fixture.el")) 4 | 5 | (defun change-buffer-to (mode) 6 | (if (version< "23.2" emacs-version) 7 | (setq default-major-mode mode) 8 | (setq major-mode mode)) 9 | (set-buffer-major-mode (current-buffer))) 10 | 11 | (expectations 12 | (desc "orutil-gethash") 13 | (expect 3 14 | (orutil-gethash hash-json "a")) 15 | (expect (type hash-table) 16 | (orutil-gethash hash-json "b")) 17 | (expect "12" 18 | (orutil-gethash hash-json "b" "c")) 19 | (expect "31" 20 | (orutil-gethash hash-json "b" "d" "e")) 21 | (expect nil 22 | (orutil-gethash hash-json "b" "a")) 23 | (expect nil 24 | (orutil-gethash hash-json "a" "c")) 25 | 26 | (desc "orutil-join") 27 | (expect "a,b,c" 28 | (orutil-join '("a" "b" "c"))) 29 | (expect "a-b-c" 30 | (orutil-join '("a" "b" "c") "-")) 31 | (expect "3%2%1" 32 | (orutil-join '(3 "2" 1) "%")) 33 | (expect "6/4/2" 34 | (orutil-join '(3 2 1) "/" '(lambda (x) (number-to-string (* x 2))))) 35 | 36 | (desc "org-redmine-template-%-to-attrkey") 37 | (expect '("id") 38 | (org-redmine-template-%-to-attrkey "%i%")) 39 | (expect '("status" "name") 40 | (org-redmine-template-%-to-attrkey "%s_n%")) 41 | (expect '("status" "id") 42 | (org-redmine-template-%-to-attrkey "%s_i%")) 43 | 44 | (desc "org-redmine-issue-attrvalue") 45 | (expect "新規" 46 | (org-redmine-issue-attrvalue fixture-issue '("status" "name"))) 47 | (expect "1" 48 | (org-redmine-issue-attrvalue fixture-issue '("id"))) 49 | 50 | (desc "org-redmine-insert-header") 51 | (expect "* #1 軌跡検知 :機能:" 52 | (with-current-buffer (exps-tmpbuf) 53 | (change-buffer-to 'org-mode) 54 | (org-redmine-insert-header fixture-issue 1) 55 | (buffer-string))) 56 | 57 | (desc "org-redmine-insert-header change template-header") 58 | (expect "* [肉体言語 Tython] #1 by Wataru MIYAGUNI" 59 | (with-current-buffer (exps-tmpbuf) 60 | (let ((org-redmine-template-header "[%p_n%] #%i% by %as_n%")) 61 | (change-buffer-to 'org-mode) 62 | (org-redmine-insert-header fixture-issue 1) 63 | (buffer-string)))) 64 | 65 | ;; (desc "org-redmine-insert-header escaped %") 66 | ;; (expect "* [%p_n%] #%i% by %Wataru MIYAGUNI" 67 | ;; (with-current-buffer (exps-tmpbuf) 68 | ;; (let ((org-redmine-template-header "[%%p_n%%] #%%i%% by %%%as_n%")) 69 | ;; (change-buffer-to 'org-mode) 70 | ;; (org-redmine-insert-header fixture-issue 1) 71 | ;; (buffer-string)))) 72 | 73 | (desc "org-redmine-insert-property") 74 | (expect "\ 75 | * hoge 76 | :PROPERTIES: 77 | :issue_id: 1 78 | :updated_on: 2011/07/06 21:27:04 +0900 79 | :project_name: 肉体言語 Tython 80 | :author: Wataru MIYAGUNI 81 | :END: 82 | " 83 | (with-current-buffer (exps-tmpbuf) 84 | (let ((org-redmine-template-property '(("project_name" . "%p_n%") 85 | ("author" . "%au_n%")))) 86 | (change-buffer-to 'org-mode) 87 | (insert "* hoge\n") 88 | (org-redmine-insert-property fixture-issue) 89 | (buffer-string)))) 90 | 91 | (expect "\ 92 | * hoge 93 | :PROPERTIES: 94 | :issue_id: 1 95 | :updated_on: 2011/07/06 21:27:04 +0900 96 | :subject: 軌跡検知 97 | :END: 98 | " 99 | (with-current-buffer (exps-tmpbuf) 100 | (let ((org-redmine-template-property '(("subject" . "%s%")))) 101 | (change-buffer-to 'org-mode) 102 | (insert "* hoge\n") 103 | (org-redmine-insert-property fixture-issue) 104 | (buffer-string)))) 105 | 106 | (desc "org-redmine-insert-property template-property is empty") 107 | (expect "\ 108 | * hoge 109 | :PROPERTIES: 110 | :issue_id: 1 111 | :updated_on: 2011/07/06 21:27:04 +0900 112 | :END: 113 | " 114 | (with-current-buffer (exps-tmpbuf) 115 | (change-buffer-to 'org-mode) 116 | (insert "* hoge\n") 117 | (org-redmine-insert-property fixture-issue) 118 | (buffer-string))) 119 | 120 | (desc "org-redmine-insert-property disable insertion") 121 | (expect "\ 122 | * hoge 123 | " 124 | (with-current-buffer (exps-tmpbuf) 125 | (change-buffer-to 'org-mode) 126 | (let ((org-redmine-template-property-use nil)) 127 | (insert "* hoge\n") 128 | (org-redmine-insert-property fixture-issue) 129 | (buffer-string)))) 130 | 131 | (desc "org-redmine-get-issue to blank buffer") 132 | (expect "\ 133 | * #1 軌跡検知 :機能: 134 | :PROPERTIES: 135 | :issue_id: 1 136 | :updated_on: 2011/07/06 21:27:04 +0900 137 | :project_name: 肉体言語 Tython 138 | :author: Wataru MIYAGUNI 139 | :END: 140 | " 141 | (stub org-redmine-curl-get => fixture-issue-json) 142 | (with-current-buffer (exps-tmpbuf) 143 | (let ((org-redmine-template-header "#%i% %s% :%t_n%:") 144 | (org-redmine-template-property '(("project_name" . "%p_n%") 145 | ("author" . "%au_n%")))) 146 | (change-buffer-to 'org-mode) 147 | (org-redmine-get-issue "1") 148 | (buffer-string)))) 149 | 150 | (desc "org-redmine-get-issue to end of subtree") 151 | (expect "\ 152 | * hoge 153 | ** fuga 154 | ** #1 軌跡検知 :機能: 155 | :PROPERTIES: 156 | :issue_id: 1 157 | :updated_on: 2011/07/06 21:27:04 +0900 158 | :author: Wataru MIYAGUNI 159 | :END: 160 | " 161 | (stub org-redmine-curl-get => fixture-issue-json) 162 | (with-current-buffer (exps-tmpbuf) 163 | (let ((org-redmine-template-header "#%i% %s% :%t_n%:") 164 | (org-redmine-template-property '(("author" . "%au_n%")))) 165 | (change-buffer-to 'org-mode) 166 | (insert "* hoge\n") 167 | (insert "** fuga\n") 168 | (org-redmine-get-issue "1") 169 | (buffer-string)))) 170 | 171 | (desc "org-redmine-get-issue to between subtree") 172 | (expect "\ 173 | * hoge 174 | ** fuga 175 | ** 肉体言語 Tython / [1] 新規 :バージョン 0.3: 176 | :PROPERTIES: 177 | :issue_id: 1 178 | :updated_on: 2011/07/06 21:27:04 +0900 179 | :subject: 軌跡検知 180 | :END: 181 | ** hago 182 | " 183 | (stub org-redmine-curl-get => fixture-issue-json) 184 | (with-current-buffer (exps-tmpbuf) 185 | (let ((org-redmine-template-header "%p_n% / [%i%] %s_n% :%c_n%:") 186 | (org-redmine-template-property '(("subject" . "%s%")))) 187 | (change-buffer-to 'org-mode) 188 | (insert "* hoge\n") 189 | (insert "** fuga\n") 190 | (insert "** hago\n") 191 | (outline-previous-visible-heading 2) 192 | (org-redmine-get-issue "1") 193 | (buffer-string)))) 194 | 195 | (desc "org-redmine-get-issue : Can't find issue id") 196 | (expect '("OrgRedmine - Not retrieved: Can't find issue #1 on http://localhost") 197 | (stub call-process => 22) 198 | (let ((org-redmine-uri "http://localhost")) 199 | (org-redmine-get-issue "1"))) 200 | 201 | (desc "org-redmine-issue-uri") 202 | (expect "http://localhost/issues/1" 203 | (let ((org-redmine-uri "http://localhost")) 204 | (org-redmine-issue-uri fixture-issue))) 205 | 206 | (desc "org-redmine-transformer-issues-source") 207 | (expect '(("#3 [肉体言語 Tython] サマーソルトキックを認識 / Wataru MIYAGUNI" 208 | . "http://localhost/issues/3") 209 | ("#2 [Gongo Kinect Diet] 走る / nil" 210 | . "http://localhost/issues/2") 211 | ("#1 [肉体言語 Tython] 軌跡検知 / Wataru MIYAGUNI" 212 | . "http://localhost/issues/1")) 213 | (let ((org-redmine-uri "http://localhost")) 214 | (mapcar 215 | (lambda (i) 216 | (cons (car i) (org-redmine-issue-uri (cdr i)))) 217 | (org-redmine-transformer-issues-source fixture-issue-all)))) 218 | 219 | (desc "org-redmine-transformer-issues-source : arg is string") 220 | (expect '(("gongo" . nil)) 221 | (org-redmine-transformer-issues-source '("gongo"))) 222 | 223 | (desc "org-redmine-config-get-limit") 224 | (expect org-redmine-limit 225 | (org-redmine-config-get-limit)) 226 | (expect 1 227 | (let ((org-redmine-limit 1)) 228 | (org-redmine-config-get-limit))) 229 | (expect 100 230 | (let ((org-redmine-limit 100)) 231 | (org-redmine-config-get-limit))) 232 | 233 | (desc "org-redmine-config-get-limit : with arg, return string of limit") 234 | (expect (type string) 235 | (org-redmine-config-get-limit t)) 236 | (expect "100" 237 | (let ((org-redmine-limit 100)) 238 | (org-redmine-config-get-limit t))) 239 | 240 | (desc "org-redmine-config-get-limit : out of range (1-100), return default limit") 241 | (expect org-redmine-limit 242 | (let ((org-redmine-limit 0)) 243 | (org-redmine-config-get-limit))) 244 | (expect org-redmine-limit 245 | (let ((org-redmine-limit 101)) 246 | (org-redmine-config-get-limit))) 247 | 248 | (desc "org-redmine-config-get-limit : not integer, return default limit") 249 | (expect org-redmine-limit 250 | (let ((org-redmine-limit "a")) 251 | (org-redmine-config-get-limit))) 252 | (expect org-redmine-limit 253 | (let ((org-redmine-limit '())) 254 | (org-redmine-config-get-limit))) 255 | 256 | (desc "org-redmine-get-issue-all : Can't get issues") 257 | (expect '("OrgRedmine - Not retrieved: Can't get issues on http://localhost") 258 | (stub call-process => 22) 259 | (let ((org-redmine-uri "http://localhost")) 260 | (org-redmine-get-issue-all nil))) 261 | 262 | (desc "orutil-date-to-float") 263 | (expect 1309954921.0 264 | (orutil-date-to-float "2011/07/06 21:22:01 +0900")) 265 | (expect (error org-redmine-exception-no-date-format "No date format") 266 | (orutil-date-to-float "2011/07/06 21:22:01 ?0900")) 267 | 268 | (desc "orutil-date-cmp") 269 | (expect t ;; check second 270 | (let ((d1 "2011/07/06 21:22:01 +0900") 271 | (d2 "2011/07/06 21:22:02 +0900")) 272 | (orutil-date-cmp d1 d2))) 273 | (expect t ;; check date 274 | (let ((d1 "2011/07/06 21:22:01 +0900") 275 | (d2 "2011/07/07 21:22:01 +0900")) 276 | (orutil-date-cmp d1 d2))) 277 | (expect t ;; check timezone 278 | (let ((d1 "2011/07/06 21:22:01 +0900") 279 | (d2 "2011/07/06 21:22:01 +0800")) 280 | (orutil-date-cmp d1 d2))) 281 | (expect nil ;; check timezone 282 | (let ((d1 "2011/07/06 21:22:01 -0900") 283 | (d2 "2011/07/06 21:22:01 +0900")) 284 | (orutil-date-cmp d1 d2))) 285 | 286 | (desc "org-redmine-entry-get-update-info") 287 | (expect '("1" . "2011/07/06 21:27:04 +0900") 288 | (stub org-redmine-curl-get => fixture-issue-json) 289 | (with-current-buffer (exps-tmpbuf) 290 | (change-buffer-to 'org-mode) 291 | (change-buffer-to 'org-mode) 292 | (org-redmine-get-issue "1") 293 | (org-redmine-entry-get-update-info))) 294 | 295 | (desc "orutil-format-with-issue") 296 | (expect "#1 [肉体言語 Tython] 軌跡検知 / Wataru MIYAGUNI" 297 | (with-current-buffer (exps-tmpbuf) 298 | (orutil-format-with-issue "#%i% [%p_n%] %s% / %as_n%" fixture-issue))) 299 | (expect "ticket (1) 軌跡検知を実装する" 300 | (with-current-buffer (exps-tmpbuf) 301 | (orutil-format-with-issue "ticket (%i%) %d%" fixture-issue))) 302 | 303 | ) 304 | -------------------------------------------------------------------------------- /test/test-helper.el: -------------------------------------------------------------------------------- 1 | (require 'ert) 2 | (require 'ert-expectations) 3 | (require 'el-mock) 4 | (require 'undercover) 5 | (undercover "org-redmine.el") 6 | 7 | (require 'org-redmine) 8 | --------------------------------------------------------------------------------