diff --git a/.ert-runner b/.ert-runner new file mode 100644 index 0000000..e35e9c9 --- /dev/null +++ b/.ert-runner @@ -0,0 +1 @@ +-L . diff --git a/.gitignore b/.gitignore index 5327376..c732041 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ /TODO.org +.cask diff --git a/Cask b/Cask new file mode 100644 index 0000000..8cc3418 --- /dev/null +++ b/Cask @@ -0,0 +1,20 @@ +(source gnu) +(source melpa) + +(package-file "org-sync.el") + +(files "omd.el" + "org-sync.el" + "org-sync-bb.el" + "org-sync-github.el" + "org-sync-redmine.el" + "org-sync-rtm.el") + +(development + (depends-on "dash") + (depends-on "dash-functional") + (depends-on "undercover") + (depends-on "ert-runner") + (depends-on "ert") + (depends-on "ert-expectations") + (depends-on "el-mock")) diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..24be470 --- /dev/null +++ b/Makefile @@ -0,0 +1,36 @@ +MODE_NAME=org-sync +VERSION=$$(grep "^;; Version: " $(MODE_NAME).el | cut -f3 -d' ') +PACKAGE_FOLDER=$(MODE_NAME)-$(VERSION) +ARCHIVE=$(PACKAGE_FOLDER).tar +EMACS=emacs + +.PHONY: clean + +deps: + cask + +build: + cask build + +clean-dist: + rm -rf dist/ + +clean: clean-dist + rm -rf *.tar + cask clean-elc + +install: + cask install + +test: clean + cask exec ert-runner + +pkg-el: + cask package + +package: clean pkg-el + cp dist/$(ARCHIVE) . + make clean-dist + +info: + cask info diff --git a/README.md b/README.md index 6f77a01..5bbe40b 100644 --- a/README.md +++ b/README.md @@ -12,13 +12,21 @@ on Worg. You can find the official git repo and contact informations there. ## Installation +### melpa + +``` +M-x package-install RET org-sync RET +``` + +### from source + Put the org-sync directory in your load-path and load the org-sync backend you need. You can add this to your .emacs: ``` emacs-lisp (add-to-list 'load-path "path/to/org-sync") (mapc 'load - '("os" "os-bb" "os-github" "os-rmine")) + '("org-sync" "org-sync-bb" "org-sync-github" "org-sync-rmine")) ``` Make sure you have `org-element.el` (it's part of recent org-mode >=). If you @@ -30,7 +38,7 @@ wget -O org-element.el 'http://orgmode.org/w/?p=org-mode.git;a=blob_plain;f=lisp ## Tutorial -Next, open a new org-mode buffer and run `M-x os-import`. It prompts you for +Next, open a new org-mode buffer and run `M-x org-sync-import`. It prompts you for an URL. You can try my Github test repo: `github.com/arbox/org-sync-test`. Org-sync should import the issues from the repo. *Note*: This is just a test repo, do not use it to report actual bugs. @@ -38,67 +46,67 @@ a test repo, do not use it to report actual bugs. Now, let's try to add a new issue. First you have to set a user/password to be able to modify the issue remotely. -Set the variable os-github-auth to like so: -`(setq os-github-auth '("ostesting" . "thisisostesting42"))` +Set the variable org-sync-github-auth to like so: +`(setq org-sync-github-auth '("ostesting" . "thisisostesting42"))` Try to add another issue e.g. insert `** OPEN my test issue`. You can type a description under it if you want. -The next step is simple, just run `M-x os-sync`. It synchronize all +The next step is simple, just run `M-x org-sync`. It synchronizes all the buglists in the document. ## How to write a new backend Writing a new backend is easy. If something is not clear, try to read -the header in `os.el` or one of the existing backend. +the header in `org-sync.el` or one of the existing backend. ``` emacs-lisp ;; backend symbol/name: demo ;; the symbol is used to find and call your backend functions (for now) ;; what kind of urls does you backend handle? -;; add it to os-backend-alist in os.el: +;; add it to org-sync-backend-alist in org-sync.el: -(defvar os-backend-alist - '(("github.com/\\(?:repos/\\)?[^/]+/[^/]+" . os-github-backend) - ("bitbucket.org/[^/]+/[^/]+" . os-bb-backend) - ("demo.com" . os-demo-backend))) +(defvar org-sync-backend-alist + '(("github.com/\\(?:repos/\\)?[^/]+/[^/]+" . org-sync-github-backend) + ("bitbucket.org/[^/]+/[^/]+" . org-sync-bb-backend) + ("demo.com" . org-sync-demo-backend))) -;; if you have already loaded os.el, you'll have to add it +;; if you have already loaded org-sync.el, you'll have to add it ;; manually in that case just eval this in *scratch* -(add-to-list 'os-backend-alist (cons "demo.com" 'os-demo-backend)) +(add-to-list 'org-sync-backend-alist (cons "demo.com" 'org-sync-demo-backend)) -;; now, in its own file os-demo.el: +;; now, in its own file org-sync-demo.el: -(require 'os) +(require 'org-sync) -;; this is the variable used in os-backend-alist -(defvar os-demo-backend - '((base-url . os-demo-base-url) - (fetch-buglist . os-demo-fetch-buglist) - (send-buglist . os-demo-send-buglist)) +;; this is the variable used in org-sync-backend-alist +(defvar org-sync-demo-backend + '((base-url . org-sync-demo-base-url) + (fetch-buglist . org-sync-demo-fetch-buglist) + (send-buglist . org-sync-demo-send-buglist)) "Demo backend.") -;; this overrides os--base-url. +;; this overrides org-sync--base-url. ;; the argument is the url the user gave. ;; it must return a cannonical version of the url that will be -;; available to your backend function in the os-base-url variable. +;; available to your backend function in the org-sync-base-url variable. ;; In the github backend, it returns API base url ;; ie. https://api.github/reposa// -(defun os-demo-base-url (url) +(defun org-sync-demo-base-url (url) "Return proper URL." "http://api.demo.com/foo") -;; this overrides os--fetch-buglist -;; you can use the variable os-base-url -(defun os-demo-fetch-buglist (last-update) +;; this overrides org-sync--fetch-buglist +;; you can use the variable org-sync-base-url +(defun org-sync-demo-fetch-buglist (last-update) "Fetch buglist from demo.com (anything that happened after LAST-UPDATE)" ;; a buglist is just a plist `(:title "Stuff at demo.com" - :url ,os-base-url + :url ,org-sync-base-url ;; add a :since property set to last-update if you return ;; only the bugs updated since it. omit it or set it to @@ -109,18 +117,18 @@ the header in `os.el` or one of the existing backend. ;; a bug is a plist too :bugs ((:id 1 :title "Foo" :status open :desc "bar.")))) -;; this overrides os--send-buglist -(defun os-demo-send-buglist (buglist) +;; this overrides org-sync--send-buglist +(defun org-sync-demo-send-buglist (buglist) "Send BUGLIST to demo.com and return updated buglist" ;; here you should loop over :bugs in buglist - (dolist (b (os-get-prop :bugs buglist)) + (dolist (b (org-sync-get-prop :bugs buglist)) (cond ;; new bug (no id) - ((null (os-get-prop :id b) + ((null (org-sync-get-prop :id b) '(do-stuff))) ;; delete bug - ((os-get-prop :delete b) + ((org-sync-get-prop :delete b) '(do-stuff)) ;; else, modified bug @@ -128,10 +136,10 @@ the header in `os.el` or one of the existing backend. '(do-stuff)))) ;; return any bug that has changed (modification date, new bugs, - ;; etc). they will overwrite/be added in the buglist in os.el + ;; etc). they will overwrite/be added in the buglist in org-sync.el ;; we return the same thing for the demo. - ;; :bugs is the only property used from this function in os.el + ;; :bugs is the only property used from this function in org-sync.el `(:bugs ((:id 1 :title "Foo" :status open :desc "bar.")))) ``` @@ -140,10 +148,10 @@ Other recognized but optionnal properties are `:date-deadline`, `:date-creation`, `:date-modification`, `:desc`. Any other properties are automatically added in the `PROPERTIES` block of the bug via `prin1-to-string` and are `read` back by org-sync. All the dates are regular emacs time object. -For more details you can look at the github backend in `os-github.el`. +For more details you can look at the github backend in `org-sync-github.el`. ## More information -You can find more in the `os.el` commentary headers. +You can find more in the `org-sync.el` commentary headers. [badge-license]: https://img.shields.io/badge/license-GPL_3-green.svg diff --git a/org-sync-bb.el b/org-sync-bb.el index 5a19b7d..369d611 100644 --- a/org-sync-bb.el +++ b/org-sync-bb.el @@ -1,4 +1,4 @@ -;;; os-bb.el --- Bitbucket backend for org-sync. +;;; org-sync-bb.el --- Bitbucket backend for org-sync. ;; Copyright (C) 2012 Aurelien Aptel ;; @@ -40,23 +40,23 @@ (defvar url-http-end-of-headers) (defvar url-http-response-status) -(defvar os-bb-backend - '((base-url . os-bb-base-url) - (fetch-buglist . os-bb-fetch-buglist) - (send-buglist . os-bb-send-buglist)) +(defvar org-sync-bb-backend + '((base-url . org-sync-bb-base-url) + (fetch-buglist . org-sync-bb-fetch-buglist) + (send-buglist . org-sync-bb-send-buglist)) "Bitbucket backend.") -(defvar os-bb-auth nil +(defvar org-sync-bb-auth nil "Bitbucket login (\"user\" . \"pwd\")") -(defun os-bb-request (method url &optional data) +(defun org-sync-bb-request (method url &optional data) "Send HTTP request at URL using METHOD with DATA. AUTH is a cons (\"user\" . \"pwd\"). Return the server decoded response in JSON." (message "%s %s %s" method url (prin1-to-string data)) (let* ((url-request-method method) (url-request-data data) - (auth os-bb-auth) + (auth org-sync-bb-auth) (buf) (url-request-extra-headers (unless data @@ -78,7 +78,7 @@ decoded response in JSON." (kill-buffer))))) ;; override -(defun os-bb-base-url (url) +(defun org-sync-bb-base-url (url) "Return base URL." (cond ;; web ui url @@ -122,31 +122,31 @@ decoded response in JSON." ;; - proposal ;; - task -(defconst os-bb-priority-list +(defconst org-sync-bb-priority-list '("trivial" "minor" "major" "critical" "blocker") "List of valid priority for a bitbucket issue.") -(defconst os-bb-status-list +(defconst org-sync-bb-status-list '("new" "open" "resolved" "on hold" "invalid" "duplicate" "wontfix") "List of valid status for a bitbucket issue.") -(defconst os-bb-kind-list +(defconst org-sync-bb-kind-list '("bug" "enhancement" "proposal" "task") "List of valid kind for a bitbucket issue.") -(defun os-bb-bug-to-form (bug) +(defun org-sync-bb-bug-to-form (bug) "Return BUG as an form alist." - (let* ((priority (os-get-prop :priority bug)) - (title (os-get-prop :title bug)) - (desc (os-get-prop :desc bug)) - (assignee (os-get-prop :assignee bug)) - (status (if (eq (os-get-prop :status bug) 'open) "open" "resolved")) - (kind (os-get-prop :kind bug))) - - (if (and priority (not (member priority os-bb-priority-list))) + (let* ((priority (org-sync-get-prop :priority bug)) + (title (org-sync-get-prop :title bug)) + (desc (org-sync-get-prop :desc bug)) + (assignee (org-sync-get-prop :assignee bug)) + (status (if (eq (org-sync-get-prop :status bug) 'open) "open" "resolved")) + (kind (org-sync-get-prop :kind bug))) + + (if (and priority (not (member priority org-sync-bb-priority-list))) (error "Invalid priority \"%s\" at bug \"%s\"." priority title)) - (if (and kind (not (member kind os-bb-kind-list))) + (if (and kind (not (member kind org-sync-bb-kind-list))) (error "Invalid kind \"%s\" at bug \"%s\"." kind title)) (cl-remove-if (lambda (x) @@ -158,7 +158,7 @@ decoded response in JSON." ("priority" . ,priority) ("kind" . ,kind))))) -(defun os-bb-post-encode (args) +(defun org-sync-bb-post-encode (args) "Return form alist ARGS as a url-encoded string." (mapconcat (lambda (arg) (concat (url-hexify-string (car arg)) @@ -166,31 +166,31 @@ decoded response in JSON." (url-hexify-string (cdr arg)))) args "&")) -(defun os-bb-repo-name (url) +(defun org-sync-bb-repo-name (url) "Return repo name at URL." (when (string-match "api\\.bitbucket.org/1\\.0/repositories/\\([^/]+\\)/\\([^/]+\\)" url) (match-string 2 url))) -(defun os-bb-repo-user (url) +(defun org-sync-bb-repo-user (url) "Return repo username at URL." (when (string-match "api\\.bitbucket.org/1\\.0/repositories/\\([^/]+\\)/\\([^/]+\\)" url) (match-string 1 url))) ;; override -(defun os-bb-fetch-buglist (last-update) - "Return the buglist at os-base-url." - (let* ((url (concat os-base-url "/issues")) - (res (os-bb-request "GET" url)) +(defun org-sync-bb-fetch-buglist (last-update) + "Return the buglist at org-sync-base-url." + (let* ((url (concat org-sync-base-url "/issues")) + (res (org-sync-bb-request "GET" url)) (code (car res)) (json (cdr res)) - (title (concat "Bugs of " (os-bb-repo-name url)))) + (title (concat "Issues of " (org-sync-bb-repo-name url)))) `(:title ,title - :url ,os-base-url - :bugs ,(mapcar 'os-bb-json-to-bug (cdr (assoc 'issues json)))))) + :url ,org-sync-base-url + :bugs ,(mapcar 'org-sync-bb-json-to-bug (cdr (assoc 'issues json)))))) -(defun os-bb-json-to-bug (json) +(defun org-sync-bb-json-to-bug (json) "Return JSON as a bug." (cl-flet* ((va (key alist) (cdr (assoc key alist))) (v (key) (va key json))) @@ -210,8 +210,8 @@ decoded response in JSON." (priority (v 'priority)) (title (v 'title)) (desc (v 'content)) - (ctime (os-parse-date (v 'utc_created_on))) - (mtime (os-parse-date (v 'utc_last_updated)))) + (ctime (org-sync-parse-date (v 'utc_created_on))) + (mtime (org-sync-parse-date (v 'utc_last_updated)))) `(:id ,id :priority ,priority @@ -227,35 +227,35 @@ decoded response in JSON." :milestone ,milestone)))) ;; override -(defun os-bb-send-buglist (buglist) +(defun org-sync-bb-send-buglist (buglist) "Send a BUGLIST on the bugtracker and return new bugs." - (let* ((new-url (concat os-base-url "/issues")) + (let* ((new-url (concat org-sync-base-url "/issues")) (new-bugs)) - (dolist (b (os-get-prop :bugs buglist)) - (let* ((id (os-get-prop :id b)) - (data (os-bb-post-encode (os-bb-bug-to-form b))) + (dolist (b (org-sync-get-prop :bugs buglist)) + (let* ((id (org-sync-get-prop :id b)) + (data (org-sync-bb-post-encode (org-sync-bb-bug-to-form b))) (modif-url (format "%s/%d/" new-url (or id 0))) res) (cond ;; new bug ((null id) - (setq res (os-bb-request "POST" new-url data)) + (setq res (org-sync-bb-request "POST" new-url data)) (when (/= (car res) 200) - (error "Can't create new bug \"%s\"" (os-get-prop :title b))) - (push (os-bb-json-to-bug (cdr res)) new-bugs)) + (error "Can't create new bug \"%s\"" (org-sync-get-prop :title b))) + (push (org-sync-bb-json-to-bug (cdr res)) new-bugs)) ;; delete bug - ((os-get-prop :delete b) - (setq res (os-bb-request "DELETE" modif-url)) + ((org-sync-get-prop :delete b) + (setq res (org-sync-bb-request "DELETE" modif-url)) (when (not (member (car res) '(404 204))) (error "Can't delete bug #%d" id))) ;; update bug (t - (setq res (os-bb-request "PUT" modif-url data)) + (setq res (org-sync-bb-request "PUT" modif-url data)) (when (/= (car res) 200) (error "Can't update bug #%id" id)) - (push (os-bb-json-to-bug (cdr res)) new-bugs))))) + (push (org-sync-bb-json-to-bug (cdr res)) new-bugs))))) `(:bugs ,new-bugs))) (provide 'org-sync-bb) diff --git a/org-sync-github.el b/org-sync-github.el index c884271..b494327 100644 --- a/org-sync-github.el +++ b/org-sync-github.el @@ -1,4 +1,4 @@ -;;; os-github.el --- Github backend for org-sync. +;;; org-sync-github.el --- Github backend for org-sync. ;; Copyright (C) 2012 Aurelien Aptel ;; @@ -38,77 +38,77 @@ (require 'org-sync) (require 'json) -(defvar os-github-backend - '((base-url . os-github-base-url) - (fetch-buglist . os-github-fetch-buglist) - (send-buglist . os-github-send-buglist)) +(defvar org-sync-github-backend + '((base-url . org-sync-github-base-url) + (fetch-buglist . org-sync-github-fetch-buglist) + (send-buglist . org-sync-github-send-buglist)) "Github backend.") (defvar url-http-end-of-headers) -(defvar os-github-auth nil +(defvar org-sync-github-auth nil "Github login (\"user\" . \"pwd\")") -(defun os-github-fetch-labels () - "Return list of labels at os-base-url." - (let* ((url (concat os-base-url "/labels")) - (json (os-github-fetch-json url))) +(defun org-sync-github-fetch-labels () + "Return list of labels at org-sync-base-url." + (let* ((url (concat org-sync-base-url "/labels")) + (json (org-sync-github-fetch-json url))) (mapcar (lambda (x) (cdr (assoc 'name x))) json))) -(defun os-github-random-color () +(defun org-sync-github-random-color () "Return a random hex color code 6 characters string without #." (random t) (format "%02X%02X%02X" (random 256) (random 256) (random 256))) -(defun os-github-color-p (color) +(defun org-sync-github-color-p (color) "Return non-nil if COLOR is a valid color code." (and (stringp color) (string-match "^[0-9a-fA-F]\\{6\\}$" color))) -(defun os-github-create-label (label &optional color) - "Create new COLOR LABEL at os-base-url and return it. +(defun org-sync-github-create-label (label &optional color) + "Create new COLOR LABEL at org-sync-base-url and return it. LABEL must be a string. COLOR must be a 6 characters string containing a hex color code without the #. Take a random color when not given." - (let* ((url (concat os-base-url "/labels")) + (let* ((url (concat org-sync-base-url "/labels")) (json (json-encode `((name . ,label) - (color . ,(if (os-github-color-p color) + (color . ,(if (org-sync-github-color-p color) color - (os-github-random-color))))))) - (os-github-request "POST" url json))) + (org-sync-github-random-color))))))) + (org-sync-github-request "POST" url json))) -(defun os-github-handle-tags (bug existing-tags) +(defun org-sync-github-handle-tags (bug existing-tags) "Create any label in BUG that is not in EXISTING-TAGS. Append new tags in EXISTING-TAGS by side effects." - (let* ((tags (os-get-prop :tags bug))) + (let* ((tags (org-sync-get-prop :tags bug))) (dolist (tag tags) - (when (os-append! tag existing-tags) - (os-github-create-label tag))))) + (when (org-sync-append! tag existing-tags) + (org-sync-github-create-label tag))))) -(defun os-github-time-to-string (time) +(defun org-sync-github-time-to-string (time) "Return TIME as a full ISO 8601 date string, but without timezone adjustments (which github doesn't support" (format-time-string "%Y-%m-%dT%TZ" time t)) ;; override -(defun os-github-fetch-buglist (last-update) - "Return the buglist at os-base-url." +(defun org-sync-github-fetch-buglist (last-update) + "Return the buglist at org-sync-base-url." (let* ((since (when last-update - (format "&since=%s" (os-github-time-to-string last-update)))) - (url (concat os-base-url "/issues?per_page=100" since)) - (json (vconcat (os-github-fetch-json url) - (os-github-fetch-json (concat url "&state=closed")))) - (title (concat "Bugs of " (os-github-repo-name url)))) + (format "&since=%s" (org-sync-github-time-to-string last-update)))) + (url (concat org-sync-base-url "/issues?per_page=100" since)) + (json (vconcat (org-sync-github-fetch-json url) + (org-sync-github-fetch-json (concat url "&state=closed")))) + (title (concat "Issues of " (org-sync-github-repo-name url)))) `(:title ,title - :url ,os-base-url - :bugs ,(mapcar 'os-github-json-to-bug json) + :url ,org-sync-base-url + :bugs ,(mapcar 'org-sync-github-json-to-bug json) :since ,last-update))) ;; override -(defun os-github-base-url (url) +(defun org-sync-github-base-url (url) "Return base url." (when (string-match "github.com/\\(?:repos/\\)?\\([^/]+\\)/\\([^/]+\\)" url) (let ((user (match-string 1 url)) @@ -116,53 +116,53 @@ Append new tags in EXISTING-TAGS by side effects." (concat "https://api.github.com/repos/" user "/" repo "")))) ;; override -(defun os-github-send-buglist (buglist) +(defun org-sync-github-send-buglist (buglist) "Send a BUGLIST on the bugtracker and return new bugs." - (let* ((new-url (concat os-base-url "/issues")) - (existing-tags (os-github-fetch-labels)) + (let* ((new-url (concat org-sync-base-url "/issues")) + (existing-tags (org-sync-github-fetch-labels)) (newbugs)) - (dolist (b (os-get-prop :bugs buglist)) - (let* ((sync (os-get-prop :sync b)) - (id (os-get-prop :id b)) - (data (os-github-bug-to-json b)) + (dolist (b (org-sync-get-prop :bugs buglist)) + (let* ((sync (org-sync-get-prop :sync b)) + (id (org-sync-get-prop :id b)) + (data (org-sync-github-bug-to-json b)) (modif-url (format "%s/%d" new-url (or id 0))) (result (cond ;; new bug ((null id) - (os-github-handle-tags b existing-tags) - (push (os-github-json-to-bug - (os-github-request "POST" new-url data)) newbugs)) + (org-sync-github-handle-tags b existing-tags) + (push (org-sync-github-json-to-bug + (org-sync-github-request "POST" new-url data)) newbugs)) ;; update bug (t - (os-github-handle-tags b existing-tags) - (os-github-request "PATCH" modif-url data)))) + (org-sync-github-handle-tags b existing-tags) + (org-sync-github-request "PATCH" modif-url data)))) (err (cdr (assoc 'message result)))) (when (stringp err) (error "Github: %s" err)))) `(:bugs ,newbugs))) -(defun os-github-fetch-json (url) +(defun org-sync-github-fetch-json (url) "Return a parsed JSON object of all the pages of URL." - (let* ((ret (os-github-fetch-json-page url)) + (let* ((ret (org-sync-github-fetch-json-page url)) (data (car ret)) (url (cdr ret)) (json data)) (while url - (setq ret (os-github-fetch-json-page url)) + (setq ret (org-sync-github-fetch-json-page url)) (setq data (car ret)) (setq url (cdr ret)) (setq json (vconcat json data))) json)) -(defun os-github-url-retrieve-synchronously (url) +(defun org-sync-github-url-retrieve-synchronously (url) "Retrieve the specified url using authentication data from -os-github-auth. AUTH is a cons (\"user\" . \"pwd\")." - (let ((auth os-github-auth)) +org-sync-github-auth. AUTH is a cons (\"user\" . \"pwd\")." + (let ((auth org-sync-github-auth)) (if (consp auth) ;; dynamically bind auth related vars (let* ((str (concat (car auth) ":" (cdr auth))) @@ -173,9 +173,9 @@ os-github-auth. AUTH is a cons (\"user\" . \"pwd\")." ;; nothing more to bind (url-retrieve-synchronously url)))) -(defun os-github-fetch-json-page (url) +(defun org-sync-github-fetch-json-page (url) "Return a cons (JSON object from URL . next page url)." - (let ((download-buffer (os-github-url-retrieve-synchronously url)) + (let ((download-buffer (org-sync-github-url-retrieve-synchronously url)) page-next header-end ret) @@ -199,47 +199,47 @@ os-github-auth. AUTH is a cons (\"user\" . \"pwd\")." (kill-buffer) ret))) -(defun os-github-request (method url &optional data) +(defun org-sync-github-request (method url &optional data) "Send HTTP request at URL using METHOD with DATA. Return the server decoded JSON response." (message "%s %s %s" method url (prin1-to-string data)) (let* ((url-request-method method) (url-request-data data) - (buf (os-github-url-retrieve-synchronously url))) + (buf (org-sync-github-url-retrieve-synchronously url))) (with-current-buffer buf (goto-char url-http-end-of-headers) (prog1 (json-read) (kill-buffer))))) -(defun os-github-repo-name (url) +(defun org-sync-github-repo-name (url) "Return the name of the repo at URL." (if (string-match "github.com/repos/[^/]+/\\([^/]+\\)" url) (match-string 1 url) "")) ;; XXX: we need an actual markdown parser here... -(defun os-github-filter-desc (desc) +(defun org-sync-github-filter-desc (desc) "Return a filtered description of a GitHub description." (if desc (progn (setq desc (replace-regexp-in-string "\r\n" "\n" desc)) (setq desc (replace-regexp-in-string "\\([^ \t\n]\\)[ \t\n]*\\'" "\\1\n" desc))))) -(defun os-github-json-to-bug (data) +(defun org-sync-github-json-to-bug (data) "Return DATA (in json) converted to a bug." (cl-flet* ((va (key alist) (cdr (assoc key alist))) (v (key) (va key data))) (let* ((id (v 'number)) (stat (if (string= (v 'state) "open") 'open 'closed)) (title (v 'title)) - (desc (os-github-filter-desc (v 'body))) + (desc (org-sync-github-filter-desc (v 'body))) (author (va 'login (v 'user))) (assignee (va 'login (v 'assignee))) (milestone-alist (v 'milestone)) (milestone (va 'title milestone-alist)) - (ctime (os-parse-date (v 'created_at))) - (dtime (os-parse-date (va 'due_on milestone-alist))) - (mtime (os-parse-date (v 'updated_at))) + (ctime (org-sync-parse-date (v 'created_at))) + (dtime (org-sync-parse-date (va 'due_on milestone-alist))) + (mtime (org-sync-parse-date (v 'updated_at))) (tags (mapcar (lambda (e) (va 'name e)) (v 'labels)))) @@ -255,18 +255,18 @@ Return the server decoded JSON response." :date-creation ,ctime :date-modification ,mtime)))) -(defun os-github-bug-to-json (bug) +(defun org-sync-github-bug-to-json (bug) "Return BUG as JSON." - (let ((state (os-get-prop :status bug))) + (let ((state (org-sync-get-prop :status bug))) (unless (member state '(open closed)) (error "Github: unsupported state \"%s\"" (symbol-name state))) (json-encode - `((title . ,(os-get-prop :title bug)) - (body . ,(os-get-prop :desc bug)) - (assignee . ,(os-get-prop :assignee bug)) - (state . ,(symbol-name (os-get-prop :status bug))) - (labels . [ ,@(os-get-prop :tags bug) ]))))) + `((title . ,(org-sync-get-prop :title bug)) + (body . ,(org-sync-get-prop :desc bug)) + (assignee . ,(org-sync-get-prop :assignee bug)) + (state . ,(symbol-name (org-sync-get-prop :status bug))) + (labels . [ ,@(org-sync-get-prop :tags bug) ]))))) (provide 'org-sync-github) ;;; org-sync-github.el ends here diff --git a/org-sync-redmine.el b/org-sync-redmine.el index 829c08d..7522ecf 100644 --- a/org-sync-redmine.el +++ b/org-sync-redmine.el @@ -1,4 +1,4 @@ -;;; os-rmine.el --- Redmine backend for org-sync. +;;; org-sync-rmine.el --- Redmine backend for org-sync. ;; Copyright (C) 2012 Aurelien Aptel ;; @@ -37,19 +37,19 @@ (defvar url-http-end-of-headers) (defvar url-http-response-status) -(defvar os-rmine-backend - '((base-url . os-rmine-base-url) - (fetch-buglist . os-rmine-fetch-buglist) - (send-buglist . os-rmine-send-buglist)) +(defvar org-sync-rmine-backend + '((base-url . org-sync-rmine-base-url) + (fetch-buglist . org-sync-rmine-fetch-buglist) + (send-buglist . org-sync-rmine-send-buglist)) "Redmine backend.") -(defvar os-rmine-auth nil +(defvar org-sync-rmine-auth nil "Redmine login (\"user\" . \"pwd\")") -(defvar os-rmine-project-id nil +(defvar org-sync-rmine-project-id nil "Project id of current buglist.") -(defconst os-rmine-date-regex +(defconst org-sync-rmine-date-regex (rx (seq (group (repeat 4 digit)) "/" @@ -66,25 +66,25 @@ (repeat 2 digit)))) "Regex to parse date returned by redmine.") -(defun os-rmine-fetch-meta () - "Set `os-rmine-project-id' for now." - (let* ((res (os-rmine-request "GET" (concat os-base-url ".json"))) +(defun org-sync-rmine-fetch-meta () + "Set `org-sync-rmine-project-id' for now." + (let* ((res (org-sync-rmine-request "GET" (concat org-sync-base-url ".json"))) (code (car res)) (json (cdr res))) (when (/= code 200) - (error "Can't fetch data from %s, wrong url?" os-base-url)) - (setq os-rmine-project-id (cdr (assoc 'id (cdr (assoc 'project json))))))) + (error "Can't fetch data from %s, wrong url?" org-sync-base-url)) + (setq org-sync-rmine-project-id (cdr (assoc 'id (cdr (assoc 'project json))))))) -(defun os-rmine-parse-date (date) +(defun org-sync-rmine-parse-date (date) "Return time object of DATE." - (when (string-match os-rmine-date-regex date) - (os-parse-date (concat (match-string 1 date) "-" + (when (string-match org-sync-rmine-date-regex date) + (org-sync-parse-date (concat (match-string 1 date) "-" (match-string 2 date) "-" (match-string 3 date) "T" (match-string 4 date) (match-string 5 date))))) -(defun os-rmine-request (method url &optional data) +(defun org-sync-rmine-request (method url &optional data) "Send HTTP request at URL using METHOD with DATA. AUTH is a cons (\"user\" . \"pwd\"). Return the server decoded response in JSON." @@ -93,11 +93,11 @@ decoded response in JSON." (url-request-extra-headers (when data '(("Content-Type" . "application/json")))) - (auth os-rmine-auth) + (auth org-sync-rmine-auth) (buf)) (when (stringp auth) - (setq url (os-url-param url `(("key" . ,auth))))) + (setq url (org-sync-url-param url `(("key" . ,auth))))) (message "%s %s %s" method url (prin1-to-string data)) (setq buf (url-retrieve-synchronously url)) @@ -108,7 +108,7 @@ decoded response in JSON." (kill-buffer))))) ;; override -(defun os-rmine-base-url (url) +(defun org-sync-rmine-base-url (url) "Return base URL." ;; if no url type, try http (when (not (string-match "^https?://" url)) @@ -120,12 +120,12 @@ decoded response in JSON." (url-host purl) (match-string 0 (url-filename purl)))))) -(defun os-rmine-repo-name (url) +(defun org-sync-rmine-repo-name (url) "Return repo name at URL." (when (string-match "projects/\\([^/]+\\)" url) (match-string 1 url))) -(defun os-rmine-json-to-bug (json) +(defun org-sync-rmine-json-to-bug (json) "Return JSON as a bug." (cl-flet* ((va (key alist) (cdr (assoc key alist))) (v (key) (va key json))) @@ -139,8 +139,8 @@ decoded response in JSON." (priority (va 'name (v 'priority))) (title (v 'subject)) (desc (v 'description)) - (ctime (os-rmine-parse-date (v 'created_on))) - (mtime (os-rmine-parse-date (v 'updated_on)))) + (ctime (org-sync-rmine-parse-date (v 'created_on))) + (mtime (org-sync-rmine-parse-date (v 'updated_on)))) `(:id ,id :priority ,priority @@ -150,71 +150,71 @@ decoded response in JSON." :date-creation ,ctime :date-modification ,mtime)))) -(defun os-rmine-fetch-buglist (last-update) - "Return the buglist at os-base-url." - (let* ((url (concat os-base-url "/issues.json")) - (res (os-rmine-request "GET" url)) +(defun org-sync-rmine-fetch-buglist (last-update) + "Return the buglist at org-sync-base-url." + (let* ((url (concat org-sync-base-url "/issues.json")) + (res (org-sync-rmine-request "GET" url)) (code (car res)) (json (cdr res)) - (title (concat "Bugs of " (os-rmine-repo-name url)))) + (title (concat "Issues of " (org-sync-rmine-repo-name url)))) `(:title ,title - :url ,os-base-url - :bugs ,(mapcar 'os-rmine-json-to-bug (cdr (assoc 'issues json)))))) + :url ,org-sync-base-url + :bugs ,(mapcar 'org-sync-rmine-json-to-bug (cdr (assoc 'issues json)))))) -(defun os-rmine-bug-to-json (bug) +(defun org-sync-rmine-bug-to-json (bug) (json-encode `((issue . - ((subject . ,(os-get-prop :title bug)) - (description . ,(os-get-prop :desc bug))))))) + ((subject . ,(org-sync-get-prop :title bug)) + (description . ,(org-sync-get-prop :desc bug))))))) -;; (defun os-rmine-code-success-p (code) +;; (defun org-sync-rmine-code-success-p (code) ;; "Return non-nil if HTTP CODE is a success code." ;; (and (<= 200 code) (< code 300))) -(defun os-rmine-send-buglist (buglist) +(defun org-sync-rmine-send-buglist (buglist) "Send a BUGLIST on the bugtracker and return new bugs." - (let* ((new-url (concat os-base-url "/issues.json")) + (let* ((new-url (concat org-sync-base-url "/issues.json")) (root-url (replace-regexp-in-string "/projects/.+" - "" os-base-url)) + "" org-sync-base-url)) new-bugs) - (os-rmine-fetch-meta) + (org-sync-rmine-fetch-meta) - (dolist (b (os-get-prop :bugs buglist)) - (let* ((id (os-get-prop :id b)) - (data (os-rmine-bug-to-json b)) + (dolist (b (org-sync-get-prop :bugs buglist)) + (let* ((id (org-sync-get-prop :id b)) + (data (org-sync-rmine-bug-to-json b)) (modif-url (format "%s/issues/%d.json" root-url (or id 0))) res) (cond ;; new bug ((null id) - (setq res (os-rmine-request "POST" new-url data)) + (setq res (org-sync-rmine-request "POST" new-url data)) (when (/= (car res) 201) - (error "Can't create new bug \"%s\"" (os-get-prop :title b))) - (push (os-rmine-json-to-bug + (error "Can't create new bug \"%s\"" (org-sync-get-prop :title b))) + (push (org-sync-rmine-json-to-bug (cdr (assoc 'issue (cdr res)))) new-bugs)) ;; delete bug - ((os-get-prop :delete b) - (setq res (os-rmine-request "DELETE" modif-url)) + ((org-sync-get-prop :delete b) + (setq res (org-sync-rmine-request "DELETE" modif-url)) (when (not (member (car res) '(404 204))) (error "Can't delete bug #%d" id))) ;; update bug (t - (setq res (os-rmine-request "PUT" modif-url data)) + (setq res (org-sync-rmine-request "PUT" modif-url data)) (when (/= (car res) 200) (error "Can't update bug #%d" id)) ;; fetch the new version since redmine doesn't send it - (setq res (os-rmine-request "GET" modif-url)) + (setq res (org-sync-rmine-request "GET" modif-url)) (when (/= (car res) 200) (error "Can't update bug #%d" id)) - (push (os-rmine-json-to-bug + (push (org-sync-rmine-json-to-bug (cdr (assoc 'issue (cdr res)))) new-bugs))))) `(:bugs ,new-bugs))) diff --git a/org-sync-rtm.el b/org-sync-rtm.el index 98c0d97..04a1031 100644 --- a/org-sync-rtm.el +++ b/org-sync-rtm.el @@ -1,4 +1,4 @@ -;;; os-rtm.el --- Remember The Milk backend for org-sync. +;;; org-sync-rtm.el --- Remember The Milk backend for org-sync. ;; Copyright (C) 2012 Aurelien Aptel ;; @@ -34,62 +34,62 @@ (require 'json) (require 'url) -(defvar os-rtm-api-key "e9b28a9ac67f1bffc3dab1bd94dab722") -(defvar os-rtm-shared-secret "caef7e509a8dcd82") -(defvar os-rtm-token nil) +(defvar org-sync-rtm-api-key "e9b28a9ac67f1bffc3dab1bd94dab722") +(defvar org-sync-rtm-shared-secret "caef7e509a8dcd82") +(defvar org-sync-rtm-token nil) (defvar url-http-end-of-headers) (defvar url-http-response-status) -(defun os-rtm-call (method &rest args) +(defun org-sync-rtm-call (method &rest args) "Call API METHOD and return result." (let* ((param `(("method" . ,method) ,@args))) - (os-rtm-request "GET" "http://api.rememberthemilk.com/services/rest/" param nil 'sign))) + (org-sync-rtm-request "GET" "http://api.rememberthemilk.com/services/rest/" param nil 'sign))) -(defvar os-rtm-backend - '((base-url . os-rtm-base-url) - (fetch-buglist . os-rtm-fetch-buglist) - (send-buglist . os-rtm-send-buglist)) +(defvar org-sync-rtm-backend + '((base-url . org-sync-rtm-base-url) + (fetch-buglist . org-sync-rtm-fetch-buglist) + (send-buglist . org-sync-rtm-send-buglist)) "Bitbucket backend.") -(defun os-rtm-base-url (url) +(defun org-sync-rtm-base-url (url) "Return base URL. Not used with RTM." url) -(defun os-rtm-filter-tasks (response) +(defun org-sync-rtm-filter-tasks (response) "Return all the real task from RTM rtm.tasks.getList RESPONSE." (let (final) (mapc (lambda (e) (when (assoc 'taskseries e) (mapc (lambda (task-series) (push task-series final)) - (os-getalist e 'taskseries)))) - (os-getalist (cdr response) 'rsp 'tasks 'list)) + (org-sync-getalist e 'taskseries)))) + (org-sync-getalist (cdr response) 'rsp 'tasks 'list)) final)) -(defun os-rtm-fetch-buglist (last-update) - (unless os-rtm-token - (os-rtm-auth)) +(defun org-sync-rtm-fetch-buglist (last-update) + (unless org-sync-rtm-token + (org-sync-rtm-auth)) (let ((bl - (mapcar 'os-rtm-task-to-bug - (os-rtm-filter-tasks (os-rtm-call "rtm.tasks.getList"))))) + (mapcar 'org-sync-rtm-task-to-bug + (org-sync-rtm-filter-tasks (org-sync-rtm-call "rtm.tasks.getList"))))) `(:title "Tasks" - :url ,os-base-url + :url ,org-sync-base-url :bugs ,bl))) -(defun os-rtm-task-to-bug (task) +(defun org-sync-rtm-task-to-bug (task) "Return TASK as a bug." - (cl-flet ((v (&rest key) (apply 'os-getalist task key))) + (cl-flet ((v (&rest key) (apply 'org-sync-getalist task key))) (let* ((id (string-to-number (v 'id))) (title (v 'name)) (status (if (string= (v 'task 'completed) "") 'open 'closed)) (priority (v 'task 'priority)) - (ctime (os-parse-date (v 'created))) - (mtime (os-parse-date (v 'modified))) - (dtime (os-parse-date (v 'task 'due)))) + (ctime (org-sync-parse-date (v 'created))) + (mtime (org-sync-parse-date (v 'modified))) + (dtime (org-sync-parse-date (v 'task 'due)))) `(:id ,id :title ,title :status ,status @@ -99,21 +99,21 @@ :date-deadline ,dtime)))) -(defun os-rtm-request (method url &optional param data sign) +(defun org-sync-rtm-request (method url &optional param data sign) "Send HTTP request at URL using METHOD with DATA." (unless (string-match "/auth/" url) (push (cons "format" "json") param)) - (when os-rtm-token - (push (cons "auth_token" os-rtm-token) param)) + (when org-sync-rtm-token + (push (cons "auth_token" org-sync-rtm-token) param)) - (push `("api_key" . ,os-rtm-api-key) param) + (push `("api_key" . ,org-sync-rtm-api-key) param) (when sign - (push `("api_sig" . ,(os-rtm-sign param)) param)) + (push `("api_sig" . ,(org-sync-rtm-sign param)) param)) - (setq url (os-url-param url param)) + (setq url (org-sync-url-param url param)) (let* ((url-request-method method) (url-request-data data) @@ -131,29 +131,29 @@ (cons url-http-response-status (ignore-errors (json-read))) (kill-buffer))))) -(defun os-rtm-auth () +(defun org-sync-rtm-auth () "Return the URL to grant access to the user account." ;; http://www.rememberthemilk.com/services/auth/?api_key=abc123&perms=delete - (let* ((res (os-rtm-call "rtm.auth.getFrob")) + (let* ((res (org-sync-rtm-call "rtm.auth.getFrob")) (frob (cdr (assoc 'frob (cl-cdadr res)))) - (param `(("api_key" . ,os-rtm-api-key) + (param `(("api_key" . ,org-sync-rtm-api-key) ("perms" . "delete") ("frob" . ,frob))) url) ;; add signature - (push `("api_sig" . ,(os-rtm-sign param)) param) - (setq url (os-url-param "http://www.rememberthemilk.com/services/auth/" param)) + (push `("api_sig" . ,(org-sync-rtm-sign param)) param) + (setq url (org-sync-url-param "http://www.rememberthemilk.com/services/auth/" param)) (browse-url url) (when (yes-or-no-p "Application accepted? ") (setq - os-rtm-token - (os-getalist - (cdr (os-rtm-call "rtm.auth.getToken" `("frob" . ,frob))) + org-sync-rtm-token + (org-sync-getalist + (cdr (org-sync-rtm-call "rtm.auth.getToken" `("frob" . ,frob))) 'rsp 'auth 'token))))) -(defun os-rtm-sign (param-alist) +(defun org-sync-rtm-sign (param-alist) "Return the signature for the PARAM-ALIST request." (let ((param (copy-tree param-alist)) sign) @@ -166,7 +166,7 @@ (md5 (message (concat - os-rtm-shared-secret + org-sync-rtm-shared-secret ;; concat key&value (mapconcat (lambda (x) (concat (car x) (cdr x))) diff --git a/org-sync.el b/org-sync.el index fd1adf8..52cc1d6 100644 --- a/org-sync.el +++ b/org-sync.el @@ -1,12 +1,13 @@ -;;; os.el --- Synchronize Org documents with external services +;;; org-sync.el --- Synchronize Org documents with external services ;; Copyright (C) 2012 Aurelien Aptel ;; Copyright (C) 2015- Andrei Beliankou ;; ;; Author: Aurelien Aptel -;; Keywords: org, synchronization +;; Keywords: org, synchronization, issues ;; Homepage: http://orgmode.org/worg/org-contrib/gsoc2012/student-projects/org-sync ;; Package-Requires: ((cl-lib "0.5")) +;; Version: 0.0.1 ;; ;; This program is free software; you can redistribute it and/or modify @@ -26,28 +27,28 @@ ;;; Commentary: -;; This package implements an extension to org-mode that synchnonizes +;; This package implements an extension to org-mode that synchronizes ;; org document with external services. It provides an interface that ;; can be implemented in backends. The current focus is on ;; bugtrackers services. -;; The entry points are `os-import', `os-sync' and `os'. The first -;; one prompts for a URL to import, the second one pulls, merges and -;; pushes every buglists in the current buffer and the third one +;; The entry points are `org-sync-import', `org-sync' and `org-sync-or-import'. +;; The first one prompts for an URL to import, the second one pulls, merges and +;; pushes every buglist in the current buffer and the third one ;; combines the others in one function: if nothing in the buffer can ;; be synchronized, ask for an URL to import. -;; The usual workflow is first to import your buglist with -;; `os-import', modify it or add a bug and run `os-sync'. +;; The usual workflow is to first import your buglist with +;; `org-sync-import', modify it or add a bug and run `org-sync'. ;; A buglist is a top-level headline which has a :url: in its ;; PROPERTIES block. This headline is composed of a list of -;; subheadlines which corresponds to bugs. The requirement for a bug +;; subheadlines which correspond to bugs. The requirement for a bug ;; is to have a state, a title and an id. If you add a new bug, it ;; wont have an id but it will get one once you sync. If you omit the ;; status, OPEN is chose. -;; The status is an org TODO state. It can be either OPEN or CLOSED. +;; The status is an org TODO state. It can either be OPEN or CLOSED. ;; The title is just the title of the headline. The id is a number in ;; the PROPERTIES block of the headline. @@ -56,13 +57,13 @@ ;; it. ;; Paragraphs under bug-headlines are considered as their description. -;; Additionnal data used by the backend are in the PROPERTIES block of +;; Additional data used by the backend are in the PROPERTIES block of ;; the bug. ;; To add a bug, just insert a new headline under the buglist you want ;; to modify e.g.: ;; ** OPEN my new bug -;; Then simply call `os-sync'. +;; Then simply call `org-sync'. ;;; Code: @@ -97,30 +98,30 @@ ;; ;; ... ;; ) -;; Some accesors are available for both structure. See `os-set-prop', -;; and `os-get-prop'. +;; Some accessors are available for both structure. See `org-sync-set-prop', +;; and `org-sync-get-prop'. ;; When importing an URL, Org-sync matches the URL against the -;; variable `os-backend-alist' which maps regexps to backend symbols. +;; variable `org-sync-backend-alist' which maps regexps to backend symbols. ;; The backend symbol is then used to call the backend functions. -;; When these functions are called, the variable `os-backend' and -;; `os-base-url' are dynamically bound to respectively the backend -;; symbol and the cannonical URL for the thing you are synching with. +;; When these functions are called, the variable `org-sync-backend' and +;; `org-sync-base-url' are dynamically bound to respectively the backend +;; symbol and the canonical URL for the thing you are syncing with. -;; The symbol part in a `os-backend-alist' pair must be a variable +;; The symbol part in a `org-sync-backend-alist' pair must be a variable ;; defined in the backend. It is an alist that maps verb to function ;; symbol. Each backend must implement at least 3 verbs: ;; * base-url (param: URL) -;; Given the user URL, returns the cannonical URL to represent it. +;; Given the user URL, returns the canonical URL to represent it. ;; This URL will be available dynamically to all of your backend -;; function through the `os-base-url' variable. +;; function through the `org-sync-base-url' variable. ;; * fetch-buglist (param: LAST-FETCH-TIME) -;; Fetch the buglist at `os-base-url'. If LAST-FETCH-TIME is non-nil, +;; Fetch the buglist at `org-sync-base-url'. If LAST-FETCH-TIME is non-nil, ;; and you only fetched things modified since it, you are expected to ;; set the property :since to it in the buglist you return. You can ;; add whatever properties you want in a bug. The lisp printer is @@ -128,73 +129,73 @@ ;; * send-buglist (param: BUGLIST) -;; Send BUGLIST to the repo at `os-base-url' and return the new bugs +;; Send BUGLIST to the repo at `org-sync-base-url' and return the new bugs ;; created that way. A bug without an id in BUGLIST is a new bug, the ;; rest are modified bug. ;; When synchronizing, Org-sync parses the current buffer using ;; org-element and convert any found buglist headline to a buglist -;; data structure. See `os-headline-to-buglist', -;; `os-headline-to-bug'. +;; data structure. See `org-sync-headline-to-buglist', +;; `org-sync-headline-to-bug'. ;; When writing buglists back to the document, Org-sync converts them ;; to elements -- the data structure used by org-element -- which are ;; then interpreted by `org-element-interpret-data'. The resulting -;; string is then inserted in the buffer. See `os-buglist-to-element' -;; and `os-bug-to-element'. +;; string is then inserted in the buffer. See `org-sync-buglist-to-element' +;; and `org-sync-bug-to-element'. (require 'cl-lib) (require 'org) (require 'org-element) -(defvar os-backend nil +(defvar org-sync-backend nil "Org-sync current backend.") -(defvar os-base-url nil +(defvar org-sync-base-url nil "Org-sync current base url.") -(defvar os-backend-alist - '(("github.com/\\(?:repos/\\)?[^/]+/[^/]+" . os-github-backend) - ("bitbucket.org/[^/]+/[^/]+" . os-bb-backend) - ("/projects/[^/]+" . os-rmine-backend) - ("rememberthemilk.com" . os-rtm-backend)) +(defvar org-sync-backend-alist + '(("github.com/\\(?:repos/\\)?[^/]+/[^/]+" . org-sync-github-backend) + ("bitbucket.org/[^/]+/[^/]+" . org-sync-bb-backend) + ("/projects/[^/]+" . org-sync-rmine-backend) + ("rememberthemilk.com" . org-sync-rtm-backend)) "Alist of url patterns vs corresponding org-sync backend.") -(defvar os-cache-file (concat user-emacs-directory "org-sync-cache") +(defvar org-sync-cache-file (concat user-emacs-directory "org-sync-cache") "Path to Org-sync cache file.") -(defvar os-cache-alist nil +(defvar org-sync-cache-alist nil "Org-sync cache for buglists. Maps URLs to buglist cache.") -(defvar os-conflict-buffer "*Org-sync conflict*" +(defvar org-sync-conflict-buffer "*Org-sync conflict*" "Name of the conflict buffer") -(defvar os-sync-props nil +(defvar org-sync-props nil "List of property to sync or nil to sync everything.") -(defun os-action-fun (action) +(defun org-sync-action-fun (action) "Return current backend ACTION function or nil." - (unless (or (null action) (null os-backend)) - (let ((fsym (assoc-default action (eval os-backend)))) + (unless (or (null action) (null org-sync-backend)) + (let ((fsym (assoc-default action (eval org-sync-backend)))) (when (fboundp fsym) fsym)))) -(defun os-get-backend (url) - "Return backend symbol matching URL from `os-backend-alist'." - (assoc-default url os-backend-alist 'string-match)) +(defun org-sync-get-backend (url) + "Return backend symbol matching URL from `org-sync-backend-alist'." + (assoc-default url org-sync-backend-alist 'string-match)) -(defmacro os-with-backend (backend &rest body) - "Eval BODY with os-backend set to corresponding BACKEND. +(defmacro org-sync-with-backend (backend &rest body) + "Eval BODY with org-sync-backend set to corresponding BACKEND. -If BACKEND evals to a string it is passed to os-get-backend, the -resulting symbol is dynamically assigned to os-backend. The url -is passed to os--base-url and dynamically assigned to -os-base-url. +If BACKEND evals to a string it is passed to org-sync-get-backend, the +resulting symbol is dynamically assigned to org-sync-backend. The url +is passed to org-sync--base-url and dynamically assigned to +org-sync-base-url. Else BACKEND should be a backend symbol. It is -assigned to os-backend." +assigned to org-sync-backend." (declare (indent 1) (debug t)) (let ((res (cl-gensym)) (url (cl-gensym))) @@ -203,35 +204,35 @@ assigned to os-backend." (,url)) (when (stringp ,res) (setq ,url ,res) - (setq ,res (os-get-backend ,url))) + (setq ,res (org-sync-get-backend ,url))) (unless (symbolp ,res) (error "Backend %s does not evaluate to a symbol." (prin1-to-string ',backend))) - (let* ((os-backend ,res) - (os-base-url (os--base-url ,url))) + (let* ((org-sync-backend ,res) + (org-sync-base-url (org-sync--base-url ,url))) ,@body)))) -(defun os-set-cache (url buglist) - "Update URL to BUGLIST in `os-cache-alist'." - (let ((cell (assoc url os-cache-alist))) +(defun org-sync-set-cache (url buglist) + "Update URL to BUGLIST in `org-sync-cache-alist'." + (let ((cell (assoc url org-sync-cache-alist))) (if cell (setcdr cell buglist) - (push (cons url buglist) os-cache-alist)))) + (push (cons url buglist) org-sync-cache-alist)))) -(defun os-get-cache (url) +(defun org-sync-get-cache (url) "Return the buglist at URL in cache or nil." - (cdr (assoc url os-cache-alist))) + (cdr (assoc url org-sync-cache-alist))) -(defun os-write-cache () - "Write Org-sync cache to `os-cache-file'." - (with-temp-file os-cache-file - (prin1 `(setq os-cache-alist ',os-cache-alist) (current-buffer)))) +(defun org-sync-write-cache () + "Write Org-sync cache to `org-sync-cache-file'." + (with-temp-file org-sync-cache-file + (prin1 `(setq org-sync-cache-alist ',org-sync-cache-alist) (current-buffer)))) -(defun os-load-cache () - "Load Org-sync cache from `os-cache-file'." - (load os-cache-file 'noerror nil)) +(defun org-sync-load-cache () + "Load Org-sync cache from `org-sync-cache-file'." + (load org-sync-cache-file 'noerror nil)) -(defun os-plist-to-alist (plist) +(defun org-sync-plist-to-alist (plist) "Return PLIST as an association list." (let* (alist cell q (p plist)) (while p @@ -245,21 +246,21 @@ assigned to os-backend." (setq p (cddr p))) alist)) -(defun os-propertize (sym) +(defun org-sync-propertize (sym) "Return sym as a property i.e. prefixed with :." (intern (concat ":" (if (symbolp sym) (symbol-name sym) sym)))) -(defun os-get-prop (key b) +(defun org-sync-get-prop (key b) "Return value of the property KEY in buglist or bug B." (plist-get b key)) -(defun os-set-prop (key val b) +(defun org-sync-set-prop (key val b) "Set KEY to VAL in buglist or bug B." (plist-put b key val)) -(defun os-append! (elem list) +(defun org-sync-append! (elem list) "Add ELEM at the end of LIST by side effect if it isn't present. Return ELEM if it was added, nil otherwise." @@ -272,30 +273,30 @@ Return ELEM if it was added, nil otherwise." (setcdr p (cons elem nil)) elem))) -(defun os--send-buglist (buglist) +(defun org-sync--send-buglist (buglist) "Send a BUGLIST on the bugtracker." - (let ((f (os-action-fun 'send-buglist))) + (let ((f (org-sync-action-fun 'send-buglist))) (if f (funcall f buglist) (error "No send backend available.")))) -(defun os--fetch-buglist (last-update) +(defun org-sync--fetch-buglist (last-update) "Return the buglist at url REPO." - (let ((f (os-action-fun 'fetch-buglist))) + (let ((f (org-sync-action-fun 'fetch-buglist))) (if f (funcall f last-update) (error "No fetch backend available.")))) -(defun os--base-url (url) +(defun org-sync--base-url (url) "Return the base url of URL." - (let ((f (os-action-fun 'base-url))) + (let ((f (org-sync-action-fun 'base-url))) (if f (funcall f url) (error "No base-url backend available.")))) -(defun os-url-param (url param) +(defun org-sync-url-param (url param) "Return URL with PARAM alist appended." (let* ((split (split-string url "\\?" t)) (base (car split)) @@ -337,29 +338,29 @@ Return ELEM if it was added, nil otherwise." final "&")))) ;; OPEN bugs sorted by mod time then CLOSED bugs sorted by mod time -(defun os-bug-sort (a b) +(defun org-sync-bug-sort (a b) "Return non-nil if bug A should appear before bug B." (cl-flet ((time-less-safe (a b) (if (and a b) (time-less-p a b) (or a b)))) - (let* ((ao (eq 'open (os-get-prop :status a))) - (bc (not (eq 'open (os-get-prop :status b)))) + (let* ((ao (eq 'open (org-sync-get-prop :status a))) + (bc (not (eq 'open (org-sync-get-prop :status b)))) (am (time-less-safe - (os-get-prop :date-modification b) - (os-get-prop :date-modification a)))) + (org-sync-get-prop :date-modification b) + (org-sync-get-prop :date-modification a)))) (or (and ao am) (and bc am) (and ao bc))))) -(defun os-buglist-to-element (bl) +(defun org-sync-buglist-to-element (bl) "Return buglist BL as an element." (let* ((skip '(:title :bugs :date-cache)) - (sorted (sort (os-get-prop :bugs bl) 'os-bug-sort)) - (elist (delq nil (mapcar 'os-bug-to-element sorted))) - (title (os-get-prop :title bl)) - (url (os-get-prop :url bl)) + (sorted (sort (org-sync-get-prop :bugs bl) 'org-sync-bug-sort)) + (elist (delq nil (mapcar 'org-sync-bug-to-element sorted))) + (title (org-sync-get-prop :title bl)) + (url (org-sync-get-prop :url bl)) (props (sort (mapcar ;; stringify prop name (lambda (x) @@ -367,47 +368,47 @@ Return ELEM if it was added, nil otherwise." ;; remove skipped prop (cl-remove-if (lambda (x) (memq (car x) skip)) - (os-plist-to-alist bl))) + (org-sync-plist-to-alist bl))) ;; sort prop by key (lambda (a b) (string< (car a) (car b)))))) - (os-set-prop :bugs sorted bl) + (org-sync-set-prop :bugs sorted bl) `(headline (:level 1 :title (,title)) (section nil - ,(os-alist-to-property-drawer props)) + ,(org-sync-alist-to-property-drawer props)) ,@elist))) -(defun os-filter-list (list minus) +(defun org-sync-filter-list (list minus) "Return a copy of LIST without elements in MINUS." (let ((final (cl-copy-seq list))) (mapc (lambda (x) (delq x final)) minus) final)) -(defun os-bug-to-element (b) +(defun org-sync-bug-to-element (b) "Return bug B as a TODO element if it is visible or nil." ;; not in PROPERTIES block (let* ((skip '(:title :status :desc :old-bug :date-deadline :date-creation :date-modification)) - (title (os-get-prop :title b)) - (dtime (os-get-prop :date-deadline b)) - (ctime (os-get-prop :date-creation b)) - (mtime (os-get-prop :date-modification b)) + (title (org-sync-get-prop :title b)) + (dtime (org-sync-get-prop :date-deadline b)) + (ctime (org-sync-get-prop :date-creation b)) + (mtime (org-sync-get-prop :date-modification b)) (prop-alist (cl-loop for (a b) on b by #'cddr if (and b (not (memq a skip))) collect (cons (substring (symbol-name a) 1) (prin1-to-string b))))) - (unless (os-get-prop :delete b) + (unless (org-sync-get-prop :delete b) ;; add date-xxx props manually in a human readable way. (push (cons "date-creation" - (os-time-to-string ctime)) prop-alist) + (org-sync-time-to-string ctime)) prop-alist) (push (cons "date-modification" - (os-time-to-string mtime)) prop-alist) + (org-sync-time-to-string mtime)) prop-alist) ;; sort PROPERTIES by property name (setq prop-alist (sort prop-alist @@ -423,33 +424,33 @@ Return ELEM if it was added, nil otherwise." (format-time-string (org-time-stamp-format) dtime)))) :level 2 :todo-type todo - :todo-keyword ,(upcase (symbol-name (os-get-prop :status b)))) + :todo-keyword ,(upcase (symbol-name (org-sync-get-prop :status b)))) (section nil - ,(os-alist-to-property-drawer prop-alist) - (fixed-width (:value ,(os-get-prop :desc b)))))))) + ,(org-sync-alist-to-property-drawer prop-alist) + (fixed-width (:value ,(org-sync-get-prop :desc b)))))))) -(defun os-headline-url (e) +(defun org-sync-headline-url (e) "Returns the url of the buglist in headline E." (cdr (assoc "url" - (os-property-drawer-to-alist + (org-sync-property-drawer-to-alist (car (org-element-contents (car (org-element-contents e)))))))) -(defun os-buglist-headline-p (elem) +(defun org-sync-buglist-headline-p (elem) "Return t if ELEM is a buglist headline." (and (eq (org-element-type elem) 'headline) - (stringp (os-headline-url elem)))) + (stringp (org-sync-headline-url elem)))) -(defun os-property-drawer-to-alist (drawer) +(defun org-sync-property-drawer-to-alist (drawer) "Return the alist of all key value pairs" (org-element-map drawer 'node-property (lambda (x) (cons (org-element-property :key x) (org-element-property :value x))))) -(defun os-alist-to-property-drawer (alist) +(defun org-sync-alist-to-property-drawer (alist) "Return the property drawer corresponding to an alist of key value pairs" `(property-drawer nil @@ -457,16 +458,16 @@ Return ELEM if it was added, nil otherwise." (lambda (x) `(node-property (:key ,(car x) :value ,(cdr x)))) alist))) -(defun os-headline-to-buglist (h) +(defun org-sync-headline-to-buglist (h) "Return headline H as a buglist." (let* ((skip '(:url)) - (alist (os-property-drawer-to-alist + (alist (org-sync-property-drawer-to-alist (car (org-element-contents (car (org-element-contents h)))))) (title (car (org-element-property :title h))) (url (cdr (assoc "url" alist))) (bugs (mapcar - 'os-headline-to-bug + 'org-sync-headline-to-bug (nthcdr 1 (org-element-contents h)))) (bl `(:title ,title :url ,url @@ -474,29 +475,29 @@ Return ELEM if it was added, nil otherwise." ;; add all other properties (mapc (lambda (x) - (let ((k (os-propertize (car x))) + (let ((k (org-sync-propertize (car x))) (v (cdr x))) (unless (memq k skip) - (os-set-prop k v bl)))) + (org-sync-set-prop k v bl)))) alist) bl)) -(defun os-headline-to-bug (h) +(defun org-sync-headline-to-bug (h) "Return headline H as a bug." (let* ((todo-keyword (org-element-property :todo-keyword h)) ;; properties to skip when looking at the PROPERTIES block (skip '(:status :title :desc :date-deadline :date-creation :date-modification)) (status (intern (downcase (or todo-keyword "open")))) - (dtime (os-parse-date (org-element-property :deadline h))) + (dtime (org-sync-parse-date (org-element-property :deadline h))) (title (car (org-element-property :title h))) (section (org-element-contents (car (org-element-contents h)))) - (headline-alist (os-property-drawer-to-alist + (headline-alist (org-sync-property-drawer-to-alist (car (org-element-contents (car (org-element-contents h)))))) - (ctime (os-parse-date (cdr (assoc "date-creation" headline-alist)))) - (mtime (os-parse-date (cdr (assoc "date-modification" headline-alist)))) + (ctime (org-sync-parse-date (cdr (assoc "date-creation" headline-alist)))) + (mtime (org-sync-parse-date (cdr (assoc "date-modification" headline-alist)))) desc bug) @@ -536,26 +537,26 @@ Return ELEM if it was added, nil otherwise." ;; add all properties (mapc (lambda (x) - (let ((k (os-propertize (car x))) + (let ((k (org-sync-propertize (car x))) (v (when (and (cdr x) (not (equal (cdr x) ""))) (read (cdr x))))) (unless (memq k skip) (setq bug (cons k (cons v bug)))))) headline-alist) bug)) -(defun os-find-buglists (elem) +(defun org-sync-find-buglists (elem) "Return every buglist headlines in ELEM." (let ((type (org-element-type elem)) (contents (org-element-contents elem))) (cond ;; if it's a buglist, return it - ((os-buglist-headline-p elem) + ((org-sync-buglist-headline-p elem) elem) ;; else if it contains elements, look recursively in it ((or (eq type 'org-data) (memq type org-element-greater-elements)) (let (buglist) (mapc (lambda (e) - (let ((h (os-find-buglists e))) + (let ((h (org-sync-find-buglists e))) (when h (setq buglist (cons h buglist))))) contents) @@ -564,7 +565,7 @@ Return ELEM if it was added, nil otherwise." (t nil)))) -(defun os-add-keyword (tree key val) +(defun org-sync-add-keyword (tree key val) "Add KEY:VAL as a header in TREE by side-effects and return TREE. If KEY is already equal to VAL, no change is made." (catch :exit @@ -588,7 +589,7 @@ If KEY is already equal to VAL, no change is made." (org-element-contents section)))))) tree) -(defun os-org-reparse () +(defun org-sync-org-reparse () "Reparse current buffer." ;; from org-ctrl-c-ctrl-c, thanks to vsync in #org-mode (let ((org-inhibit-startup-visibility-stuff t) @@ -598,17 +599,17 @@ If KEY is already equal to VAL, no change is made." (setq org-table-coordinate-overlays nil)) (org-save-outline-visibility 'use-markers (org-mode-restart)))) -(defun os-import (url) +(defun org-sync-import (url) "Fetch and insert at point bugs from URL." (interactive "sURL: ") - (os-with-backend url - (let* ((buglist (os--fetch-buglist nil)) - (elem (os-buglist-to-element buglist)) + (org-sync-with-backend url + (let* ((buglist (org-sync--fetch-buglist nil)) + (elem (org-sync-buglist-to-element buglist)) (bug-keyword '(sequence "OPEN" "|" "CLOSED"))) ;; we add the buglist to the cache - (os-set-prop :date-cache (current-time) buglist) - (os-set-cache os-base-url buglist) + (org-sync-set-prop :date-cache (current-time) buglist) + (org-sync-set-cache org-sync-base-url buglist) (save-excursion (insert (org-element-interpret-data @@ -621,35 +622,35 @@ If KEY is already equal to VAL, no change is made." ;; the buffer has to be reparsed in order to have the new ;; keyword taken into account - (os-org-reparse))))) + (org-sync-org-reparse))))) (message "Import complete.")) -(defun os-get-bug-id (buglist id) +(defun org-sync-get-bug-id (buglist id) "Return bug ID from BUGLIST." (when id (catch :exit (mapc (lambda (x) - (let ((current-id (os-get-prop :id x))) + (let ((current-id (org-sync-get-prop :id x))) (when (and (numberp current-id) (= current-id id)) (throw :exit x)))) - (os-get-prop :bugs buglist)) + (org-sync-get-prop :bugs buglist)) nil))) -(defun os-buglist-dups (buglist) +(defun org-sync-buglist-dups (buglist) "Return non-nil if BUGLIST contains bugs with the same id. The value returned is a list of duplicated ids." (let ((hash (make-hash-table)) (dups)) (mapc (lambda (x) - (let ((id (os-get-prop :id x))) + (let ((id (org-sync-get-prop :id x))) (puthash id (1+ (gethash id hash 0)) hash))) - (os-get-prop :bugs buglist)) + (org-sync-get-prop :bugs buglist)) (maphash (lambda (id nb) (when (> nb 1) (push id dups))) hash) dups)) -(defun os-time-max (&rest timelist) +(defun org-sync-time-max (&rest timelist) "Return the largest time in TIMELIST." (cl-reduce (lambda (a b) (if (and a b) @@ -657,13 +658,13 @@ The value returned is a list of duplicated ids." (or a b)) timelist)) -(defun os-buglist-last-update (buglist) +(defun org-sync-buglist-last-update (buglist) "Return the most recent creation/modi date in BUGLIST." - (apply 'os-time-max (cl-loop for x in (os-get-prop :bugs buglist) - collect (os-get-prop :date-creation x) and - collect (os-get-prop :date-modification x)))) + (apply 'org-sync-time-max (cl-loop for x in (org-sync-get-prop :bugs buglist) + collect (org-sync-get-prop :date-creation x) and + collect (org-sync-get-prop :date-modification x)))) -(defun os-set-equal (a b) +(defun org-sync-set-equal (a b) "Return t if list A and B have the same elements, no matter the order." (catch :exit (mapc (lambda (e) @@ -676,16 +677,16 @@ The value returned is a list of duplicated ids." b) t)) -(defun os-parse-date (date) +(defun org-sync-parse-date (date) "Parse and return DATE as a time or nil." (when (and (stringp date) (not (string= date ""))) (date-to-time date))) -(defun os-time-to-string (time) +(defun org-sync-time-to-string (time) "Return TIME as a full ISO 8601 date string." (format-time-string "%Y-%m-%dT%T%z" time)) -(defun os-bug-diff (a b) +(defun org-sync-bug-diff (a b) "Return an alist of properties that differs in A and B or nil if A = B. The form of the alist is ((:property . (valueA valueB)...)" (let ((diff) @@ -695,35 +696,35 @@ The form of the alist is ((:property . (valueA valueB)...)" (cl-loop for (bkey bval) on b by #'cddr collect bkey)))) (delete-dups props-list) (dolist (key props-list diff) - (let ((va (os-get-prop key a)) - (vb (os-get-prop key b))) + (let ((va (org-sync-get-prop key a)) + (vb (org-sync-get-prop key b))) (unless (equal va vb) (setq diff (cons `(,key . (,va ,vb)) diff))))))) -(defun os-bug-prop-equalp (prop a b) +(defun org-sync-bug-prop-equalp (prop a b) "Return t if bug A PROP = bug B PROP, nil otherwise." - (equal (os-get-prop prop a) (os-get-prop prop b))) + (equal (org-sync-get-prop prop a) (org-sync-get-prop prop b))) -(defun os-buglist-diff (a b) +(defun org-sync-buglist-diff (a b) "Return a diff buglist which turns buglist A to B when applied. This function makes the assumption that A ⊂ B." (let (diff) - (dolist (bbug (os-get-prop :bugs b)) - (let ((abug (os-get-bug-id a (os-get-prop :id bbug)))) - (when (or (null abug) (os-bug-diff abug bbug)) + (dolist (bbug (org-sync-get-prop :bugs b)) + (let ((abug (org-sync-get-bug-id a (org-sync-get-prop :id bbug)))) + (when (or (null abug) (org-sync-bug-diff abug bbug)) (push bbug diff)))) `(:bugs ,diff))) -(defun os-merge-diff (local remote) +(defun org-sync-merge-diff (local remote) "Return the merge of LOCAL diff and REMOTE diff. The merge is the union of the diff. Conflicting bugs are tagged with :sync conflict-local or conflict-remote." (let ((added (make-hash-table)) merge) ;; add all local bugs - (dolist (lbug (os-get-prop :bugs local)) - (let* ((id (os-get-prop :id lbug)) - (rbug (os-get-bug-id remote id)) + (dolist (lbug (org-sync-get-prop :bugs local)) + (let* ((id (org-sync-get-prop :id lbug)) + (rbug (org-sync-get-bug-id remote id)) rnew lnew) ;; if there's a remote bug with the same id, we have a @@ -732,12 +733,12 @@ with :sync conflict-local or conflict-remote." ;; if the local bug has a sync prop, it was merged by the ;; user, so we keep the local one (which might be the ;; remote from a previous sync) - (if (and rbug (null (os-get-prop :sync lbug)) (os-bug-diff lbug rbug)) + (if (and rbug (null (org-sync-get-prop :sync lbug)) (org-sync-bug-diff lbug rbug)) (progn (setq lnew (copy-tree lbug)) - (os-set-prop :sync 'conflict-local lnew) + (org-sync-set-prop :sync 'conflict-local lnew) (setq rnew (copy-tree rbug)) - (os-set-prop :sync 'conflict-remote rnew) + (org-sync-set-prop :sync 'conflict-remote rnew) (push rnew merge) (push lnew merge)) (progn @@ -747,60 +748,60 @@ with :sync conflict-local or conflict-remote." (puthash id t added))) ;; add new remote bug which are the unmarked bugs in remote - (dolist (rbug (os-get-prop :bugs remote)) - (unless (gethash (os-get-prop :id rbug) added) + (dolist (rbug (org-sync-get-prop :bugs remote)) + (unless (gethash (org-sync-get-prop :id rbug) added) (push rbug merge))) `(:bugs ,merge))) -(defun os-update-buglist (base diff) +(defun org-sync-update-buglist (base diff) "Apply buglist DIFF to buglist BASE and return the result. -This is done according to `os-sync-props'." +This is done according to `org-sync-props'." (let ((added (make-hash-table)) new) - (dolist (bug (os-get-prop :bugs base)) - (let* ((id (os-get-prop :id bug)) - (diff-bug (os-get-bug-id diff id)) + (dolist (bug (org-sync-get-prop :bugs base)) + (let* ((id (org-sync-get-prop :id bug)) + (diff-bug (org-sync-get-bug-id diff id)) new-bug) - (if (and os-sync-props diff-bug) + (if (and org-sync-props diff-bug) (progn (setq new-bug bug) (mapc (lambda (p) - (os-set-prop p (os-get-prop p diff-bug) new-bug)) - os-sync-props)) + (org-sync-set-prop p (org-sync-get-prop p diff-bug) new-bug)) + org-sync-props)) (setq new-bug (or diff-bug bug))) (push new-bug new) (puthash id t added))) - (dolist (bug (os-get-prop :bugs diff)) - (let ((id (os-get-prop :id bug))) + (dolist (bug (org-sync-get-prop :bugs diff)) + (let ((id (org-sync-get-prop :id bug))) (when (or (null id) (null (gethash id added))) (push bug new)))) (let ((new-buglist (cl-copy-list base))) - (os-set-prop :bugs new new-buglist) + (org-sync-set-prop :bugs new new-buglist) new-buglist))) -(defun os-remove-unidentified-bug (buglist) +(defun org-sync-remove-unidentified-bug (buglist) "Remove bugs without id from BUGLIST." (let ((new-bugs)) - (dolist (b (os-get-prop :bugs buglist)) - (when (os-get-prop :id b) + (dolist (b (org-sync-get-prop :bugs buglist)) + (when (org-sync-get-prop :id b) (push b new-bugs))) - (os-set-prop :bugs new-bugs buglist) + (org-sync-set-prop :bugs new-bugs buglist) buglist)) -(defun os-replace-headline-by-buglist (headline buglist) +(defun org-sync-replace-headline-by-buglist (headline buglist) "Replace HEADLINE by BUGLIST by side effects." - (let ((new-headline (os-buglist-to-element buglist))) + (let ((new-headline (org-sync-buglist-to-element buglist))) (setf (car headline) (car new-headline) (cdr headline) (cdr new-headline)))) -(defun os-show-conflict (buglist url) +(defun org-sync-show-conflict (buglist url) "Show conflict in BUGLIST at URL in conflict window." - (let ((buf (get-buffer-create os-conflict-buffer))) + (let ((buf (get-buffer-create org-sync-conflict-buffer))) (with-help-window buf (with-current-buffer buf (erase-buffer) @@ -809,58 +810,58 @@ This is done according to `os-sync-props'." are the problematic items. Look at the :sync property to know their origin. Copy what you want to keep in your org buffer and sync again.\n\n") - (dolist (b (os-get-prop :bugs buglist)) - (when (and b (os-get-prop :sync b)) - (insert (org-element-interpret-data (os-bug-to-element b)) + (dolist (b (org-sync-get-prop :bugs buglist)) + (when (and b (org-sync-get-prop :sync b)) + (insert (org-element-interpret-data (org-sync-bug-to-element b)) "\n"))))))) -(defun os-getalist (obj &rest keys) +(defun org-sync-getalist (obj &rest keys) "Apply assoc in nested alist OBJ with KEYS." (let ((p obj)) (dolist (k keys p) (setq p (cdr (assoc k p)))))) -(defun os-filter-bug (bug) - "Filter BUG according to `os-sync-props'." - (if os-sync-props - (let ((new-bug `(:id ,(os-get-prop :id bug)))) +(defun org-sync-filter-bug (bug) + "Filter BUG according to `org-sync-props'." + (if org-sync-props + (let ((new-bug `(:id ,(org-sync-get-prop :id bug)))) (mapc (lambda (x) - (os-set-prop x (os-get-prop x bug) new-bug)) - os-sync-props) + (org-sync-set-prop x (org-sync-get-prop x bug) new-bug)) + org-sync-props) new-bug) bug)) -(defun os-filter-diff (diff) - "Filter DIFF according to `os-sync-props'." - (when os-sync-props +(defun org-sync-filter-diff (diff) + "Filter DIFF according to `org-sync-props'." + (when org-sync-props (let (final) - (dolist (b (os-get-prop :bugs diff)) - (let ((id (os-get-prop :id b))) + (dolist (b (org-sync-get-prop :bugs diff)) + (let ((id (org-sync-get-prop :id b))) ;; drop new bugs (when id - (push (os-filter-bug b) final)))) - (os-set-prop :bugs final diff))) + (push (org-sync-filter-bug b) final)))) + (org-sync-set-prop :bugs final diff))) diff) -(defun os-sync () +(defun org-sync () "Update buglists in current buffer." (interactive) - (ignore-errors (kill-buffer os-conflict-buffer)) + (ignore-errors (kill-buffer org-sync-conflict-buffer)) ;; parse the buffer and find the buglist-looking headlines (let* ((local-doc (org-element-parse-buffer)) - (local-headlines (os-find-buglists local-doc))) + (local-headlines (org-sync-find-buglists local-doc))) ;; for each of these headlines, convert it to buglist (dolist (headline local-headlines) - (let* ((local (os-headline-to-buglist headline)) - (url (os-get-prop :url local))) + (let* ((local (org-sync-headline-to-buglist headline)) + (url (org-sync-get-prop :url local))) ;; if it has several bug with the same id, stop - (when (os-buglist-dups local) + (when (org-sync-buglist-dups local) (error "Buglist \"%s\" contains unmerged bugs." - (os-get-prop :title local))) + (org-sync-get-prop :title local))) ;; local cache remote ;; \ / \ / @@ -878,50 +879,50 @@ sync again.\n\n") ;; new cache/local/remote ;; handle buglist with the approriate backend - (os-with-backend url - (let* ((cache (os-get-cache os-base-url)) - (last-fetch (os-get-prop :date-cache cache)) - (local-diff (os-buglist-diff cache local)) - remote remote-diff merged merged-diff) - - ;; fetch remote buglist - (if last-fetch - ;; make a partial fetch and apply it to cache if the backend - ;; supports it - (let* ((partial-fetch (os--fetch-buglist last-fetch))) - (if (os-get-prop :since partial-fetch) - (setq remote (os-update-buglist cache partial-fetch)) - (setq remote partial-fetch))) - (setq remote (os--fetch-buglist nil))) - ;; at this point remote is the full remote buglist - - (setq remote-diff (os-buglist-diff cache remote)) - (setq merged-diff (os-merge-diff local-diff remote-diff)) - - ;; filter according to os-sync-props - (os-filter-diff merged-diff) - - (setq merged (os-update-buglist local merged-diff)) - - ;; if merged-diff has duplicate bugs, there's a conflict - (let ((dups (os-buglist-dups merged-diff))) - (if dups - (progn - (message "Synchronization failed, manual merge needed.") - (os-show-conflict merged-diff os-base-url)) - - ;; else update buffer and cache - (setq merged - (os-remove-unidentified-bug - (os-update-buglist merged (os--send-buglist merged-diff)))) - (os-set-prop :date-cache (current-time) merged) - (os-set-cache os-base-url merged) - (message "Synchronization complete."))) - - ;; replace headlines in local-doc - (os-replace-headline-by-buglist headline merged))))) - - (os-add-keyword local-doc "TODO" "OPEN | CLOSED") + (org-sync-with-backend url + (let* ((cache (org-sync-get-cache org-sync-base-url)) + (last-fetch (org-sync-get-prop :date-cache cache)) + (local-diff (org-sync-buglist-diff cache local)) + remote remote-diff merged merged-diff) + + ;; fetch remote buglist + (if last-fetch + ;; make a partial fetch and apply it to cache if the backend + ;; supports it + (let* ((partial-fetch (org-sync--fetch-buglist last-fetch))) + (if (org-sync-get-prop :since partial-fetch) + (setq remote (org-sync-update-buglist cache partial-fetch)) + (setq remote partial-fetch))) + (setq remote (org-sync--fetch-buglist nil))) + ;; at this point remote is the full remote buglist + + (setq remote-diff (org-sync-buglist-diff cache remote)) + (setq merged-diff (org-sync-merge-diff local-diff remote-diff)) + + ;; filter according to org-sync-props + (org-sync-filter-diff merged-diff) + + (setq merged (org-sync-update-buglist local merged-diff)) + + ;; if merged-diff has duplicate bugs, there's a conflict + (let ((dups (org-sync-buglist-dups merged-diff))) + (if dups + (progn + (message "Synchronization failed, manual merge needed.") + (org-sync-show-conflict merged-diff org-sync-base-url)) + + ;; else update buffer and cache + (setq merged + (org-sync-remove-unidentified-bug + (org-sync-update-buglist merged (org-sync--send-buglist merged-diff)))) + (org-sync-set-prop :date-cache (current-time) merged) + (org-sync-set-cache org-sync-base-url merged) + (message "Synchronization complete."))) + + ;; replace headlines in local-doc + (org-sync-replace-headline-by-buglist headline merged))))) + + (org-sync-add-keyword local-doc "TODO" "OPEN | CLOSED") ;; since we replace the whole buffer, save-excusion doesn't work so ;; we manually (re)store the point @@ -931,16 +932,16 @@ sync again.\n\n") (insert (org-element-interpret-data local-doc)) (goto-char oldpoint)))) -(defun os () +(defun org-sync-or-import () "Synchronize current buffer or import an external document. If no Org-sync elements are present in the buffer, ask for a URL to import otherwise synchronize the buffer." (interactive) (let* ((local-doc (org-element-parse-buffer))) - (if (os-find-buglists local-doc) - (os-sync) - (call-interactively 'os-import)))) + (if (org-sync-find-buglists local-doc) + (org-sync) + (call-interactively 'org-sync-import)))) (provide 'org-sync) ;;; org-sync.el ends here diff --git a/test/omd-test.el b/test/omd-test.el new file mode 100644 index 0000000..2310924 --- /dev/null +++ b/test/omd-test.el @@ -0,0 +1,46 @@ +;;; omd-test.el --- -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Antoine Romain Dumont + +;; Author: Antoine Romain Dumont +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'dash-functional) + +(ert-deftest test-omd-rand () + (should + (let ((min 1) + (max 100)) + (->> (number-sequence 1 10) + (-map (lambda (_) (omd-rand min max))) + (--every? (and (<= min it) (< it max))))))) + +(ert-deftest test-omd-random-word () + (let ((seq-length (number-sequence 1 10))) + (->> seq-length + (-map (-compose 'length 'omd-random-word)) + (equal seq-length)))) + +;; ... + +(provide 'omd-test) +;;; omd-test.el ends here diff --git a/test/test-helper.el b/test/test-helper.el new file mode 100644 index 0000000..4b18bc7 --- /dev/null +++ b/test/test-helper.el @@ -0,0 +1,36 @@ +;;; test-helper.el --- -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Antoine Romain Dumont + +;; Author: Antoine Romain Dumont +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'undercover) +(undercover "*.el" + (:exclude "*-test.el") + (:report-file "/tmp/undercover-report.json")) + +(require 'omd) +(require 'org-sync) + +(provide 'test-helper) +;;; test-helper.el ends here