my-emacs-d/elpa/rtm-20160116.927/rtm.el

698 lines
24 KiB
EmacsLisp
Raw Normal View History

2016-10-17 21:42:31 +00:00
;;; rtm.el --- An elisp implementation of the Remember The Milk API
;; Copyright (C) 2009 Friedrich Delgado Friedrichs
;; uses parts of org-rtm.el Copyright (C) 2008 Avdi Grimm
;; Modified by Philipp Middendorf (pmidden@secure.mailbox.org) 2016
;; Author: Friedrich Delgado Friedrichs <frie...@nomaden.org>
;; Created: Oct 18 2009
;; Version: 0.1
;; Package-Version: 20160116.927
;; Package-Requires: ((cl-lib "1.0"))
;; Keywords: remember the milk productivity todo
;; URL: https://github.com/pmiddend/emacs-rtm
;; This product uses the Remember The Milk API but is not endorsed or
;; certified by Remember The Milk
;; This file is NOT part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Note by Philipp: This file was taken from the simple-rtm repository and
;; has some minor modifications so it doesn't give byte-compilation
;; warnings.
;;; Code:
(require 'cl-lib)
(require 'url-http)
(require 'url-util)
(require 'xml)
(require 'custom)
;;;; Customisation
(defgroup rtm nil
"Options for emacs lisp integration of Remember The Milk"
:tag "elisp RTM"
:group 'applications)
(defcustom rtm-api-key "d40eb4df08dd52c1930afa9d79dceda0"
"Your own API key for Remember The Milk."
:type 'string :group 'rtm)
(defcustom rtm-api-shared-secret "39d8e367fdce977c"
"Your shared secret for your Remember The Milk API Key.
Note that in an open source application it is not easily possible to
hide the secret. That's why it's probably the best solution for every
user to register their own API key.
See also
http://groups.google.com/group/rememberthemilk-api/browse_thread/thread/dcb035f162d4dcc8%3Fpli%3D1
You can register your own API key and secret under
http://www.rememberthemilk.com/services/api/requestkey.rtm
In the description just tell them you're going to use the emacs lisp
API Kit"
:type 'string :group 'rtm)
;;;; constants and variables
(defconst rtm-rest-uri "http://api.rememberthemilk.com/services/rest/"
"Endpoint URL for REST requests. See
http://www.rememberthemilk.com/services/api/request.rest.rtm")
(defconst rtm-auth-uri "http://www.rememberthemilk.com/services/auth/"
"Authentication service URL, see
http://www.rememberthemilk.com/services/api/authentication.rtm")
(defvar rtm-auth-token ""
"Auth token received from RTM Website, after the user authenticated
your app")
(defvar rtm-auth-token-valid nil
"Set to t after the auth token has been validated.")
(defconst rtm-ui-buffer-name "*rtm*"
"Name for the rtm user interface buffer")
(defconst rtm-auth-token-file ".rtm-auth-token"
"Name for storing the auth token for the current session")
(defvar rtm-current-timeline nil
"The current timeline")
(defvar rtm-debug nil
"debug level")
(make-variable-buffer-local 'rtm-auth-token-valid)
(put 'rtm-auth-token-valid 'permanent-local t)
;;;; API wrappers
(defmacro def-rtm-method (methodname rtm-method-name call-func result-func
result-path &rest parms)
(declare (indent 1))
`(defun ,methodname ,parms
(,result-func ,result-path
(,call-func ',rtm-method-name
,@(mapcar (lambda (sym)
`(cons ,(symbol-name sym) ,sym))
;; remove lambda keywords
(cl-remove-if (lambda (sym)
(or (eq sym '&optional)
(eq sym '&rest)))
parms))))))
(defmacro def-rtm-macro (macro-name call-func result-func)
(declare (indent 0))
`(defmacro ,macro-name (methodname rtm-method-name result-path &rest parms)
(declare (indent 1))
`(def-rtm-method ,methodname ,rtm-method-name ,',call-func
,',result-func
',result-path ,@parms)))
(def-rtm-macro def-rtm-signed-scalar-method
rtm-call-signed rtm-get-scalar-from-response)
(def-rtm-macro def-rtm-authenticated-scalar-method
rtm-call-authenticated rtm-get-scalar-from-response)
(def-rtm-macro def-rtm-timeline-scalar-method
rtm-call-timeline rtm-get-scalar-from-response)
(def-rtm-macro def-rtm-signed-list-method
rtm-call-signed rtm-get-list-from-response)
(def-rtm-macro def-rtm-authenticated-list-method
rtm-call-authenticated rtm-get-list-from-response)
(def-rtm-macro def-rtm-timeline-list-method
rtm-call-timeline rtm-get-list-from-response)
;; awfully brief aliases, but those long names mess up indentation
;; recomendation: use only the authenticated aliases, and the long
;; names for those (rarely used) methods that are only signed
(defalias 'def-rtm-si-sca 'def-rtm-signed-scalar-method)
(defalias 'def-rtm-authenticated-scalar-method 'def-rtm-authenticated-scalar-method)
(defalias 'def-rtm-authenticated-scalar-method! 'def-rtm-timeline-scalar-method)
(defalias 'def-rtm-si-lis 'def-rtm-signed-list-method)
(defalias 'def-rtm-list 'def-rtm-authenticated-list-method)
(defalias 'def-rtm-list! 'def-rtm-timeline-list-method)
;; TODO: I removed the usages of the aliases above - do I have to rewrite
;; these calls as well?
(put 'def-rtm-si-sca 'lisp-indent-function 1)
(put 'def-rtm-authenticated-scalar-method 'lisp-indent-function 1)
(put 'def-rtm-authenticated-scalar-method! 'lisp-indent-function 1)
(put 'def-rtm-si-lis 'lisp-indent--function 1)
(put 'def-rtm-list 'lisp-indent-function 1)
(put 'def-rtm-list! 'lisp-indent-function 1)
;; note that, for modifying functions, it's mostly better to define
;; them via define-rtm-list!, since you will receive the transaction
;; *and* the result, while a function defined via define-rtm-scalar!
;; will only return the transaction
(defun rtm-call-unsigned (method &rest params)
(let ((request (rtm-construct-request-url rtm-rest-uri
(rtm-prepare-params method
params))))
(rtm-do-request request)))
(defun rtm-call-signed (method &rest params)
(let* ((unsigned-params (rtm-prepare-params method params))
(all-params (append-api-sig unsigned-params))
(request (rtm-construct-request-url rtm-rest-uri
all-params)))
(rtm-do-request request)))
(defun rtm-call-authenticated (method &rest params)
(apply #'rtm-call-signed
method
`("auth_token" . ,(rtm-authenticate))
params))
(defun rtm-call-timeline (method &rest params)
(apply #'rtm-call-authenticated
method
`("timeline" . ,(rtm-timeline))
params))
(defun rtm-get-nodes-from-node-list (node-name node-list)
(cl-remove-if-not (lambda (el) (eq node-name
(xml-node-name el)))
node-list))
(defun rtm-get-node-content-from-response (node-name response)
(xml-node-children (car (rtm-get-nodes-from-node-list node-name
response))))
(defun rtm-get-list-from-response (path response)
(let ((rst path)
(content response))
(while rst
(setq content (rtm-get-node-content-from-response (car rst) content))
(setq rst (cdr rst)))
content))
(defun rtm-get-scalar-from-response (path response)
(car (rtm-get-list-from-response path response)))
;;;;; Actual api wrappers from
;; http://www.rememberthemilk.com/services/api/methods/
;;;;;; auth
(def-rtm-signed-scalar-method rtm-auth-check-token rtm.auth.checkToken
(auth token) auth_token)
;; api call response (without post-processing):
;; ((auth nil
;; (token nil "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx")
;; (perms nil "delete")
;; (user
;; ((id . "xxxxxxx")
;; (username . "johndoe")
;; (fullname . "John Doe")))))
(def-rtm-signed-scalar-method rtm-auth-get-frob rtm.auth.getFrob (frob))
(def-rtm-signed-scalar-method rtm-auth-get-token rtm.auth.getToken
(auth token) frob)
;; api call response (without post-processing):
;; ((auth nil (token nil "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX")
;; (perms nil "delete") (user (... ... ...))))
;;;;;; contacts
(def-rtm-timeline-list-method rtm-contacts-add rtm.contacts.add (contact) contact)
(def-rtm-timeline-list-method rtm-contacts-delete rtm.contacts.delete () contact_id)
(def-rtm-authenticated-list-method rtm-contacts-get-list rtm.contacts.getList (contacts))
;;;;;; groups
(def-rtm-timeline-list-method rtm-groups-add rtm.groups.add () group)
(def-rtm-timeline-list-method rtm-groups-add-contact rtm.groups.addContact ()
group_id contact_id)
(def-rtm-timeline-list-method rtm-groups-delete rtm.groups.delete () group_id)
(def-rtm-authenticated-list-method rtm-groups-get-list rtm.groups.getList ())
(def-rtm-timeline-list-method rtm-groups-remove-contact rtm.groups.removeContact ()
group_id contact_id)
;;;;;; lists
(def-rtm-timeline-list-method rtm-lists-add rtm.lists.add ()
name &optional filter)
(def-rtm-timeline-list-method rtm-lists-archive rtm.lists.archive ()
list_id)
(def-rtm-timeline-list-method rtm-lists-delete rtm.lists.delete ()
list_id)
(def-rtm-authenticated-list-method rtm-lists-get-list rtm.lists.getList (lists))
;; example response (after result function):
;; ((list
;; ((id . "7781815")
;; (name . "Inbox")
;; (deleted . "0")
;; (locked . "1")
;; (archived . "0")
;; (position . "-1")
;; (smart . "0")
;; (sort_order . "0")))
;; (list
;; ((id . "7781820")
;; (name . "All Tasks")
;; (deleted . "0")
;; (locked . "0")
;; (archived . "0")
;; (position . "0")
;; (smart . "1")
;; (sort_order . "0"))
;; (filter nil))
;; (list
;; ((id . "7781818")
;; (name . "Work")
;; (deleted . "0")
;; (locked . "0")
;; (archived . "0")
;; (position . "0")
;; (smart . "0")
;; (sort_order . "0")))
;; (list
;; ((id . "7781816")
;; (name . "Private")
;; (deleted . "0")
;; (locked . "0")
;; (archived . "0")
;; (position . "0")
;; (smart . "0")
;; (sort_order . "0")))
;; (list
;; ((id . "7781819")
;; (name . "Sent")
;; (deleted . "0")
;; (locked . "1")
;; (archived . "0")
;; (position . "1")
;; (smart . "0")
;; (sort_order . "0"))))
(def-rtm-timeline-list-method rtm-lists-set-default-list rtm.lists.setDefaultList ()
list_id)
(def-rtm-timeline-list-method rtm-lists-set-name rtm.lists.setName ()
list_id name)
(def-rtm-timeline-list-method rtm-lists-unarchive rtm.lists.unarchive ()
list_id)
;;;;;; locations
(def-rtm-authenticated-list-method rtm-locations-get-list rtm.locations.getList (locations))
;;;;;; reflection
(def-rtm-signed-list-method rtm-reflection-get-methods rtm.reflection.getMethods
(methods))
(def-rtm-signed-scalar-method rtm-reflection-get-method-info
rtm.reflection.getMethodInfo () method_name)
;;;;;; settings
(def-rtm-authenticated-list-method rtm-settings-get-list rtm.settings.getList (settings))
;;;;;; tasks
(def-rtm-timeline-list-method rtm-tasks-add rtm.tasks.add ()
name &optional parse list_id)
(def-rtm-timeline-list-method rtm-tasks-add-tags rtm.tasks.addTags ()
list_id taskseries_id task_id tags)
(def-rtm-timeline-list-method rtm-tasks-complete rtm.tasks.complete ()
list_id taskseries_id task_id)
(def-rtm-timeline-list-method rtm-tasks-delete rtm.tasks.delete ()
list_id taskseries_id task_id)
(def-rtm-authenticated-list-method rtm-tasks-get-list rtm.tasks.getList (tasks)
&optional list_id filter last_sync)
;; example response (after result function):
;; ((list
;; ((id . "7781819")))
;; (list
;; ((id . "7781817")))
;; (list
;; ((id . "7781816"))
;; (taskseries
;; ((id . "35272531")
;; (created . "2009-03-08T20:57:45Z")
;; (modified . "2009-03-08T21:52:18Z")
;; (name . "Try Remember The Milk")
;; (source . "js")
;; (url . "")
;; (location_id . ""))
;; (tags nil)
;; (participants nil)
;; (notes nil)
;; (task
;; ((id . "49791364")
;; (due . "2009-03-08T20:57:00Z")
;; (has_due_time . "1")
;; (added . "2009-03-08T20:57:45Z")
;; (completed . "2009-03-08T21:52:16Z")
;; (deleted . "")
;; (priority . "1")
;; (postponed . "0")
;; (estimate . "")))))
;; (list
;; ((id . "7781818")))
;; (list
;; ((id . "7781820"))))
(def-rtm-timeline-list-method rtm-tasks-move-priority rtm.tasks.movePriority ()
list_id taskseries_id task_id direction)
(def-rtm-timeline-list-method rtm-tasks-move-to rtm.tasks.moveTo ()
from_list_id to_list_id taskseries_id task_id)
(def-rtm-timeline-list-method rtm-tasks-postpone rtm.tasks.postpone ()
list_id taskseries_id task_id)
(def-rtm-timeline-list-method rtm-tasks-remove-tags rtm.tasks.removeTags ()
list_id taskseries_id task_id tags)
(def-rtm-timeline-list-method rtm-tasks-set-due-date rtm.tasks.setDueDate ()
list_id taskseries_id task_id &optional due has_due_time parse)
(def-rtm-timeline-list-method rtm-tasks-set-estimate rtm.tasks.setEstimate ()
list_id taskseries_id task_id &optional estimate)
(def-rtm-timeline-list-method rtm-tasks-set-location rtm.tasks.setLocation ()
list_id taskseries_id task_id &optional location_id)
(def-rtm-timeline-list-method rtm-tasks-set-name rtm.tasks.setName ()
list_id taskseries_id task_id name)
(def-rtm-timeline-list-method rtm-tasks-set-priority rtm.tasks.setPriority ()
list_id taskseries_id task_id &optional priority)
(def-rtm-timeline-list-method rtm-tasks-set-recurrence rtm.tasks.setRecurrence ()
list_id taskseries_id task_id &optional repeat)
(def-rtm-timeline-list-method rtm-tasks-set-tags rtm.tasks.setTags ()
list_id taskseries_id task_id &optional tags)
(def-rtm-timeline-list-method rtm-tasks-set-url rtm.tasks.setURL ()
list_id taskseries_id task_id &optional url)
(def-rtm-timeline-list-method rtm-tasks-uncomplete rtm.tasks.uncomplete ()
list_id taskseries_id task_id)
;;;;;; tasks.notes
(def-rtm-timeline-list-method rtm-tasks-notes-add rtm.tasks.notes.add ()
list_id taskseries_id task_id note_title note_text)
(def-rtm-timeline-list-method rtm-tasks-notes-delete rtm.tasks.notes.delete ()
note_id)
(def-rtm-timeline-list-method rtm-tasks-notes-edit rtm.tasks.notes.edit ()
note_id note_title note_text)
;;;;;; test
(defun rtm-test-echo ()
(rtm-call-unsigned 'rtm.test.echo))
(def-rtm-authenticated-list-method rtm-test-login rtm.test.login ())
;;;;;; time
(def-rtm-signed-list-method rtm-time-convert rtm.time.convert ()
to_timezone &optional from_timezone time)
;;;;;; timelines
(def-rtm-authenticated-scalar-method rtm-timelines-create rtm.timelines.create (timeline))
(defun rtm-timeline ()
(unless rtm-current-timeline
(progn
(setq rtm-current-timeline (rtm-timelines-create))))
rtm-current-timeline)
;;;;;; timezones
(def-rtm-signed-list-method rtm-timezones-get-list rtm.timezones.getList ())
;;;;;; transactions
(def-rtm-timeline-list-method rtm-transactions-undo rtm.transactions.undo () transaction_id)
;;;; User authentication
(defun rtm-authenticate ()
"Always use this function to call an authenticated method, it's the only one
that will update rtm-auth-token"
(setq rtm-auth-token
(let ((auth-token (or (rtm-get-stored-auth-token)
rtm-auth-token)))
(if (and auth-token
(rtm-auth-token-valid auth-token))
auth-token
(rtm-get-new-auth-token))))
rtm-auth-token)
(defun rtm-auth-token-valid (auth-token)
(if rtm-auth-token-valid
t
(let ((token (ignore-errors (rtm-auth-check-token auth-token))))
(if (and token
(string-equal auth-token token))
(setq rtm-auth-token-valid t)
nil))))
(defun rtm-get-new-auth-token ()
(let* ((frob (rtm-auth-get-frob))
(auth-url (rtm-authentication-url 'delete frob))
(auth-token nil))
(while (not auth-token)
(browse-url auth-url)
(rtm-authentication-dialog auth-url)
(setq auth-token
(rtm-auth-get-token frob))
(if (rtm-auth-token-valid auth-token)
(rtm-store-auth-token auth-token)
(setq auth-token nil)))
auth-token))
(defun rtm-store-auth-token (auth-token)
(let ((token-file (locate-user-emacs-file rtm-auth-token-file)))
(unless (file-exists-p token-file)
(with-temp-file token-file))
(set-file-modes token-file #o600)
(with-temp-file token-file
(insert auth-token)))
auth-token)
(defun rtm-get-stored-auth-token ()
(let ((token-file (locate-user-emacs-file rtm-auth-token-file)))
(if (file-exists-p token-file)
(if (file-readable-p token-file)
(with-temp-buffer
(insert-file-contents token-file)
(buffer-string))
(error "Auth token store %s exists, but is not readable."
token-file))
nil)))
(defun rtm-authentication-dialog (auth-url)
(let ((rtm-buffer (generate-new-buffer rtm-ui-buffer-name)))
(with-current-buffer rtm-buffer
(insert "Please visit the following url to authenticate this
application:\n\n")
(insert-text-button auth-url 'type 'rtm-url)
(display-buffer rtm-buffer)
;; (redisplay)
(read-from-minibuffer
"Press RETURN if after authentication was granted")
(kill-buffer rtm-buffer))))
(define-button-type 'rtm-url
'action (lambda (x)
(let ((button (button-at (point))))
(browse-url
(button-label button))))
'follow-link t)
(define-button-type 'rtm-button
'follow-link t)
(defun rtm-authentication-url (perms frob)
(let* ((unsigned-params `(("api_key" . ,rtm-api-key)
("perms" . ,(maybe-string perms))
("frob" . ,frob)))
(all-params (append-api-sig unsigned-params)))
(rtm-construct-request-url rtm-auth-uri
all-params)))
;;;; WebAPI handling
(defun rtm-do-request (request)
(if rtm-debug
(message "request: %s" request))
(rtm-parse-response (url-retrieve-synchronously request)))
;; adapted from avdi's code:
(defun rtm-api-sig (params)
(let* ((param-copy (cl-copy-list params))
(sorted-params (sort param-copy
(lambda (lhs rhs) (string< (car lhs) (car rhs)))))
(joined-params (mapcar (lambda (param)
(concat (car param) (cdr param)))
sorted-params))
(params-str (cl-reduce 'concat joined-params))
(with-secret (concat rtm-api-shared-secret params-str)))
(md5 with-secret)))
(defun rtm-prepare-params (method params)
(rtm-add-method+api method
(rtm-stringify-params (rtm-weed-empty-params params))))
(defun rtm-stringify-params (params)
(mapcar #'rtm-stringify-param params))
(defun rtm-stringify-param (param)
(let* ((name (car param))
(value (cdr param)))
(cons (rtm-stringify-param-name name)
(rtm-stringify-value value))))
(defun rtm-stringify-param-name (name)
(cond ((stringp name)
name)
((symbolp name)
(symbol-name name))))
;; note: because we can't really tell between parameter wasn't given
;; and explicitly set as nil (see rtm-weed-empty-params below), you
;; should give 'false rather than nil if you mean false
(defun rtm-stringify-value (value)
(cond ((stringp value)
value)
((eq t value)
"true")
((null value)
"false")
((listp value)
(rtm-comma-separated-list value))
((symbolp value)
(symbol-name value))
((numberp value)
(number-to-string value))))
(defun rtm-comma-separated-list (lis)
"turn a list into a comma separated string (and flatten it)"
(cl-labels ((comsep (lis first)
(if (null lis)
""
(concat (if first "" ",")
(rtm-stringify-value (car lis))
(comsep (cdr lis) nil)))))
(comsep lis t)))
(defun rtm-weed-empty-params (params)
(cl-remove-if (lambda (param)
(and (listp param)
(not (null param))
(null (cdr param))))
params))
(defun rtm-add-method+api (method params)
(append `(("method" . ,(maybe-string method))
("api_key" . ,rtm-api-key))
params))
;; adapted from avdi's code:
(defun rtm-construct-request-url (base-uri params)
"Construct a URL for calling a method from params"
(let* ((param-pairs (mapcar 'rtm-format-param params))
(query (rtm-join-params param-pairs)))
(string-to-unibyte (concat base-uri "?" query))))
;; adapted from avdi's code:
(defun rtm-format-param (param)
(let ((key (car param))
(value (cdr param)))
;; it's important that we sign the unencoded parameters, but of
;; course the request must be url-encoded
(concat key "=" (url-hexify-string value))))
;; from avdi's code:
(defun rtm-join-params (params)
(cl-reduce (lambda (left right) (concat left "&" right)) params))
;; adapted from avdi's code:
(defun rtm-construct-url (method)
(concat rtm-rest-uri
"?"
"method=" method
"&"
"api_key=" rtm-api-key))
;; from avdi's code:
;; TODO Interpret the stat attribute and throw an error if it's not ok
(defun rtm-parse-response (response)
(with-current-buffer response
(let* ((node-list (xml-parse-region (point-min) (point-max)))
(rsps (rtm-get-nodes-from-node-list 'rsp node-list)))
(when (> (length rsps) 1)
(warn
"Got more than one <rsp> node in response, please examine!
Response:%s" (pp node-list)))
(let* ((rsp (car rsps))
(children (xml-node-children rsp))
(stat (rtm-stat rsp)))
(unless stat
(warn "Weird, got no stat attribute in <rsp> node.
%s" (pp node-list)))
(if (eq stat 'ok)
children
(let* ((err (car (rtm-get-nodes-from-node-list 'err children)))
(code (xml-get-attribute err 'code))
(msg (xml-get-attribute err 'msg)))
(error "Error in server response: Code: %s\n
Message: \"%s\"" code msg)))))))
(defun rtm-stat (rsp)
(let ((stat (xml-get-attribute-or-nil rsp 'stat)))
(if stat
(intern (downcase stat))
stat)))
;;; example responses
;; failure:
;; ((rsp
;; ((stat . "fail"))
;; (err
;; ((code . "97")
;; (msg . "Missing signature")))))
;; success:
;; rtm.auth.getFrob:
;; ((rsp
;; ((stat . "ok"))
;; (frob nil "cce8d04e182212cddd5cdc815e09648fecd18e0e")))
;; rtm.test.echo:
;; ((rsp ((stat . "ok"))
;; (api_key nil "00000000000000000000000000000000")
;; (method nil "rtm.test.echo")))
(defun append-api-sig (unsigned-params)
(let ((api-sig (rtm-api-sig unsigned-params)))
(append unsigned-params
`(("api_sig" . ,api-sig)))))
;;;; Misc/Helper functions
(defun maybe-string (symbol-or-string)
(if (stringp symbol-or-string) symbol-or-string
(symbol-name symbol-or-string)))
(provide 'rtm)
;;; rtm.el ends here