]> code.delx.au - gnu-emacs/blobdiff - lisp/org/org-mobile.el
Merge from emacs-23
[gnu-emacs] / lisp / org / org-mobile.el
index cc45859987419a3cc36f1651f9984f78ec1daa3d..86c2e34639a285be59c2d1ba47c8fdb0122eb6a8 100644 (file)
@@ -4,7 +4,7 @@
 ;; Author: Carsten Dominik <carsten at orgmode dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://orgmode.org
-;; Version: 6.33x
+;; Version: 7.4
 ;;
 ;; This file is part of GNU Emacs.
 ;;
 ;;; Commentary:
 ;;
 ;; This file contains the code to interact with Richard Moreland's iPhone
-;; application MobileOrg.  This code is documented in Appendix B of the
-;; Org-mode manual.  The code is not specific for the iPhone, however.
-;; Any external viewer/flagging/editing application that uses the same
-;; conventions could be used.
+;; application MobileOrg, as well as with the Android version by Matthew Jones.
+;; This code is documented in Appendix B of the Org-mode manual.  The code is
+;; not specific for the iPhone and Android - any external
+;; viewer/flagging/editing application that uses the same conventions could
+;; be used.
 
 (require 'org)
 (require 'org-agenda)
+;;; Code:
+
 (eval-when-compile (require 'cl))
 
 (defgroup org-mobile nil
@@ -47,7 +50,7 @@ directly.  Directories will be search for files with the extension `.org'.
 In addition to this, the list may also contain the following symbols:
 
 org-agenda-files
-     This means, include the complete, unrestricted list of files given in
+     This means include the complete, unrestricted list of files given in
      the variable `org-agenda-files'.
 org-agenda-text-search-extra-files
      Include the files given in the variable
@@ -65,6 +68,52 @@ org-agenda-text-search-extra-files
   :group 'org-mobile
   :type 'directory)
 
+(defcustom org-mobile-use-encryption nil
+  "Non-nil means keep only encrypted files on the WebDAV server.
+Encryption uses AES-256, with a password given in
+`org-mobile-encryption-password'.
+When nil, plain files are kept on the server.
+Turning on encryption requires to set the same password in the MobileOrg
+application.  Before turning this on, check of MobileOrg does already
+support it - at the time of this writing it did not yet."
+  :group 'org-mobile
+  :type 'boolean)
+
+(defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt"
+  "File that is being used as a temporary file for encryption.
+This must be local file on your local machine (not on the WebDAV server).
+You might want to put this file into a directory where only you have access."
+  :group 'org-mobile
+  :type 'directory)
+
+(defcustom org-mobile-encryption-password ""
+  "Password for encrypting files uploaded to the server.
+This is a single password which is used for AES-256 encryption.  The same
+password must also be set in the MobileOrg application.  All Org files,
+including mobileorg.org will be encrypted using this password.
+
+SECURITY CONSIDERATIONS:
+
+Note that, when Org runs the encryption commands, the password could
+be visible briefly on your system with the `ps' command.  So this method is
+only intended to keep the files secure on the server, not on your own machine.
+
+Also, if you set this variable in an init file (.emacs or .emacs.d/init.el
+or custom.el...) and if that file is stored in a way so that other can read
+it, this also limits the security of this approach.  You can also leave
+this variable empty - Org will then ask for the password once per Emacs
+session."
+  :group 'org-mobile
+  :type '(string :tag "Password"))
+
+(defvar org-mobile-encryption-password-session nil)
+
+(defun org-mobile-encryption-password ()
+  (or (org-string-nw-p org-mobile-encryption-password)
+      (org-string-nw-p org-mobile-encryption-password-session)
+      (setq org-mobile-encryption-password-session
+           (read-passwd "Password for MobileOrg: " t))))
+
 (defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org"
   "The file where captured notes and flags will be appended to.
 During the execution of `org-mobile-pull', the file
@@ -85,13 +134,29 @@ should point to this file."
   :group 'org-mobile
   :type 'file)
 
+(defcustom org-mobile-agendas 'all
+  "The agendas that should be pushed to MobileOrg.
+Allowed values:
+
+default  the weekly agenda and the global TODO list
+custom   all custom agendas defined by the user
+all      the custom agendas and the default ones
+list     a list of selection key(s) as string."
+  :group 'org-mobile
+  :type '(choice
+         (const :tag "Default Agendas" default)
+         (const :tag "Custom Agendas" custom)
+         (const :tag "Default and Custom Agendas" all)
+         (repeat :tag "Selected"
+                 (string :tag "Selection Keys"))))
+
 (defcustom org-mobile-force-id-on-agenda-items t
-  "Non-nil means make all agenda items carry and ID."
+  "Non-nil means make all agenda items carry an ID."
   :group 'org-mobile
   :type 'boolean)
 
 (defcustom org-mobile-force-mobile-change nil
-  "Non-nil means, force the change made on the mobile device.
+  "Non-nil means force the change made on the mobile device.
 So even if there have been changes to the computer version of the entry,
 force the new value set on the mobile.
 When nil, mark the entry from the mobile with an error message.
@@ -247,15 +312,14 @@ create all custom agenda views, for upload to the mobile phone."
          (kill-buffer a-buffer)
        (let ((cw (selected-window)))
          (select-window (get-buffer-window a-buffer))
-         
          (org-agenda-redo)
          (select-window cw)))))
   (message "Files for mobile viewer staged"))
-  
+
 (defvar org-mobile-before-process-capture-hook nil
   "Hook that is run after content was moved to `org-mobile-inbox-for-pull'.
-The inbox file is in the current buffer, and the buffer is arrowed to the
-new captured data.")
+The inbox file is visited by the current buffer, and the buffer is
+narrowed to the newly captured data.")
 
 ;;;###autoload
 (defun org-mobile-pull ()
@@ -285,6 +349,7 @@ agenda view showing the flagged items."
 
 (defun org-mobile-check-setup ()
   "Check if org-mobile-directory has been set up."
+  (org-mobile-cleanup-encryption-tempfile)
   (unless (and org-directory
               (stringp org-directory)
               (string-match "\\S-" org-directory)
@@ -305,7 +370,19 @@ agenda view showing the flagged items."
               (file-exists-p
                (file-name-directory org-mobile-inbox-for-pull)))
     (error
-     "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory")))
+     "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory"))
+  (unless (and org-mobile-checksum-binary
+              (string-match "\\S-" org-mobile-checksum-binary))
+    (error "No executable found to compute checksums"))
+  (when org-mobile-use-encryption
+    (unless (string-match "\\S-" (org-mobile-encryption-password))
+      (error
+       "To use encryption, you must set `org-mobile-encryption-password'"))
+    (unless (file-writable-p org-mobile-encryption-tempfile)
+      (error "Cannot write to encryption tempfile %s"
+            org-mobile-encryption-tempfile))
+    (unless (executable-find "openssl")
+      (error "openssl is needed to encrypt files"))))
 
 (defun org-mobile-create-index-file ()
   "Write the index file in the WebDAV directory."
@@ -313,8 +390,10 @@ agenda view showing the flagged items."
                           (lambda (a b) (string< (cdr a) (cdr b)))))
        (def-todo (default-value 'org-todo-keywords))
        (def-tags (default-value 'org-tag-alist))
+       (target-file (expand-file-name org-mobile-index-file
+                                      org-mobile-directory))
        file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds)
-    
+
     (org-prepare-agenda-buffers (mapcar 'car files-alist))
     (setq done-kwds (org-uniquify org-done-keywords-for-agenda))
     (setq todo-kwds (org-delete-all
@@ -331,7 +410,9 @@ agenda view showing the flagged items."
                               (t nil)))
                       org-tag-alist-for-agenda))))
     (with-temp-file
-       (expand-file-name org-mobile-index-file org-mobile-directory)
+       (if org-mobile-use-encryption
+           org-mobile-encryption-tempfile
+         target-file)
       (while (setq entry (pop def-todo))
        (insert "#+READONLY\n")
        (setq kwds (mapcar (lambda (x) (if (string-match "(" x)
@@ -372,7 +453,11 @@ agenda view showing the flagged items."
        (insert (format "* [[file:%s][%s]]\n"
                        link-name link-name)))
       (push (cons org-mobile-index-file (md5 (buffer-string)))
-           org-mobile-checksum-files))))
+           org-mobile-checksum-files))
+    (when org-mobile-use-encryption
+      (org-mobile-encrypt-and-move org-mobile-encryption-tempfile
+                                  target-file)
+      (org-mobile-cleanup-encryption-tempfile))))
 
 (defun org-mobile-copy-agenda-files ()
   "Copy all agenda files to the stage or WebDAV directory."
@@ -385,21 +470,29 @@ agenda view showing the flagged items."
              target-dir (file-name-directory target-path))
        (unless (file-directory-p target-dir)
          (make-directory target-dir 'parents))
-       (copy-file file target-path 'ok-if-exists)
+       (if org-mobile-use-encryption
+           (org-mobile-encrypt-and-move file target-path)
+         (copy-file file target-path 'ok-if-exists))
        (setq check (shell-command-to-string
                     (concat org-mobile-checksum-binary " "
                             (shell-quote-argument (expand-file-name file)))))
        (when (string-match "[a-fA-F0-9]\\{30,40\\}" check)
          (push (cons link-name (match-string 0 check))
                org-mobile-checksum-files))))
+
     (setq file (expand-file-name org-mobile-capture-file
                                 org-mobile-directory))
     (save-excursion
       (setq buf (find-file file))
-      (and (= (point-min) (point-max)) (insert "\n"))
-      (save-buffer)
+      (when (and (= (point-min) (point-max))) 
+       (insert "\n")
+       (save-buffer)
+       (when org-mobile-use-encryption
+         (write-file org-mobile-encryption-tempfile)
+         (org-mobile-encrypt-and-move org-mobile-encryption-tempfile file)))
       (push (cons org-mobile-capture-file (md5 (buffer-string)))
            org-mobile-checksum-files))
+    (org-mobile-cleanup-encryption-tempfile)
     (kill-buffer buf)))
 
 (defun org-mobile-write-checksums ()
@@ -426,8 +519,22 @@ The table of checksums is written to the file mobile-checksums."
                        ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
                        (t (cons (car x) (cons "" (cdr x))))))
                org-agenda-custom-commands)))
-       new e key desc type match settings cmds gkey gdesc gsettings cnt)
-    (while (setq e (pop custom-list))
+       (default-list '(("a" "Agenda" agenda) ("t" "All TODO" alltodo)))
+       thelist new e key desc type match settings cmds gkey gdesc gsettings cnt)
+    (cond
+     ((eq org-mobile-agendas 'custom)
+      (setq thelist custom-list))
+     ((eq org-mobile-agendas 'default)
+      (setq thelist default-list))
+     ((eq org-mobile-agendas 'all)
+      (setq thelist custom-list)
+      (unless (assoc "t" thelist) (push '("t" "ALL TODO" alltodo) thelist))
+      (unless (assoc "a" thelist) (push '("a" "Agenda" agenda) thelist)))
+     ((listp org-mobile-agendas)
+      (setq thelist (append custom-list default-list))
+      (setq thelist (delq nil (mapcar (lambda (k) (assoc k thelist))
+                                     org-mobile-agendas)))))
+    (while (setq e (pop thelist))
       (cond
        ((stringp (cdr e))
        ;; this is a description entry - skip it
@@ -438,7 +545,12 @@ The table of checksums is written to the file mobile-checksums."
        ((memq (nth 2 e) '(todo-tree tags-tree occur-tree))
        ;; These are trees, not really agenda commands
        )
-       ((memq (nth 2 e) '(agenda todo tags))
+       ((and (memq (nth 2 e) '(todo tags tags-todo))
+            (or (null (nth 3 e))
+                (not (string-match "\\S-" (nth 3 e)))))
+       ;; These would be interactive because the match string is empty
+       )
+       ((memq (nth 2 e) '(agenda alltodo todo tags tags-todo))
        ;; a normal command
        (setq key (car e) desc (nth 1 e) type (nth 2 e) match (nth 3 e)
              settings (nth 4 e))
@@ -527,40 +639,105 @@ The table of checksums is written to the file mobile-checksums."
                        (if (org-bound-and-true-p
                             org-mobile-force-id-on-agenda-items)
                            (org-id-get m 'create)
-                         (org-entry-get m "ID")))
+                         (or (org-entry-get m "ID")
+                             (org-mobile-get-outline-path-link m))))
              (insert "   :PROPERTIES:\n   :ORIGINAL_ID: " id
                      "\n   :END:\n")))))
        (beginning-of-line 2))
-      (push (cons (file-name-nondirectory file) (md5 (buffer-string)))
+      (push (cons "agendas.org" (md5 (buffer-string)))
            org-mobile-checksum-files))
     (message "Agenda written to Org file %s" file)))
 
+(defun org-mobile-get-outline-path-link (pom)
+  (org-with-point-at pom
+    (concat "olp:"
+           (org-mobile-escape-olp (file-name-nondirectory buffer-file-name))
+           "/"
+           (mapconcat 'org-mobile-escape-olp
+                      (org-get-outline-path)
+                      "/")
+           "/"
+           (org-mobile-escape-olp (nth 4 (org-heading-components))))))
+
+(defun org-mobile-escape-olp (s)
+  (let  ((table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f"))))
+    (org-link-escape s table)))
+
 ;;;###autoload
 (defun org-mobile-create-sumo-agenda ()
   "Create a file that contains all custom agenda views."
   (interactive)
   (let* ((file (expand-file-name "agendas.org"
                                 org-mobile-directory))
+        (file1 (if org-mobile-use-encryption
+                   org-mobile-encryption-tempfile
+                 file))
         (sumo (org-mobile-sumo-agenda-command))
         (org-agenda-custom-commands
-         (list (append sumo (list (list file)))))
+         (list (append sumo (list (list file1)))))
         (org-mobile-creating-agendas t))
-    (unless (file-writable-p file)
-      (error "Cannot write to file %s" file))
+    (unless (file-writable-p file1)
+      (error "Cannot write to file %s" file1))
     (when sumo
-      (org-store-agenda-views))))
+      (org-store-agenda-views))
+    (when org-mobile-use-encryption
+      (org-mobile-encrypt-and-move file1 file)
+      (delete-file file1)
+      (org-mobile-cleanup-encryption-tempfile))))
+
+(defun org-mobile-encrypt-and-move (infile outfile)
+  "Encrypt INFILE locally to INFILE_enc, then move it to OUTFILE.
+We do this in two steps so that remote paths will work, even if the
+encryption program does not understand them."
+  (let ((encfile (concat infile "_enc")))
+    (org-mobile-encrypt-file infile encfile)
+    (when outfile
+      (copy-file encfile outfile 'ok-if-exists)
+      (delete-file encfile))))
+
+(defun org-mobile-encrypt-file (infile outfile)
+  "Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
+  (shell-command
+   (format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s"
+          (shell-quote-argument (concat "pass:"
+                                        (org-mobile-encryption-password)))
+          (shell-quote-argument (expand-file-name infile))
+          (shell-quote-argument (expand-file-name outfile)))))
+
+(defun org-mobile-decrypt-file (infile outfile)
+  "Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
+  (shell-command
+   (format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s"
+          (shell-quote-argument (concat "pass:"
+                                        (org-mobile-encryption-password)))
+          (shell-quote-argument (expand-file-name infile))
+          (shell-quote-argument (expand-file-name outfile)))))
+
+(defun org-mobile-cleanup-encryption-tempfile ()
+  "Remove the encryption tempfile if it exists."
+  (and (stringp org-mobile-encryption-tempfile)
+       (file-exists-p org-mobile-encryption-tempfile)
+       (delete-file org-mobile-encryption-tempfile)))
 
 (defun org-mobile-move-capture ()
   "Move the contents of the capture file to the inbox file.
 Return a marker to the location where the new content has been added.
 If nothing new has been added, return nil."
   (interactive)
-  (let ((inbox-buffer (find-file-noselect org-mobile-inbox-for-pull))
-       (capture-buffer (find-file-noselect
-                        (expand-file-name org-mobile-capture-file
-                                          org-mobile-directory)))
-       (insertion-point (make-marker))
-       not-empty content)
+  (let* ((encfile nil)
+        (capture-file (expand-file-name org-mobile-capture-file
+                                        org-mobile-directory))
+        (inbox-buffer (find-file-noselect org-mobile-inbox-for-pull))
+        (capture-buffer
+         (if (not org-mobile-use-encryption)
+             (find-file-noselect capture-file)
+           (org-mobile-cleanup-encryption-tempfile)
+           (setq encfile (concat org-mobile-encryption-tempfile "_enc"))
+           (copy-file capture-file encfile)
+           (org-mobile-decrypt-file encfile org-mobile-encryption-tempfile)
+           (find-file-noselect org-mobile-encryption-tempfile)))
+        (insertion-point (make-marker))
+        not-empty content)
     (with-current-buffer capture-buffer
       (setq content (buffer-string))
       (setq not-empty (string-match "\\S-" content))
@@ -577,9 +754,14 @@ If nothing new has been added, return nil."
        (save-buffer)
        (org-mobile-update-checksum-for-capture-file (buffer-string))))
     (kill-buffer capture-buffer)
+    (when org-mobile-use-encryption
+      (org-mobile-encrypt-and-move org-mobile-encryption-tempfile
+                                  capture-file)
+      (org-mobile-cleanup-encryption-tempfile))
     (if not-empty insertion-point)))
 
 (defun org-mobile-update-checksum-for-capture-file (buffer-string)
+  "Find the checksum line and modify it to match BUFFER-STRING."
   (let* ((file (expand-file-name "checksums.dat" org-mobile-directory))
         (buffer (find-file-noselect file)))
     (when buffer
@@ -781,42 +963,6 @@ FIXME: Hmmm, not sure if we can make his work against the
 auto-correction feature.  Needs a bit more thinking.  So this function
 is currently a noop.")
 
-
-(defun org-find-olp (path)
-  "Return  a marker pointing to the entry at outline path OLP.
-If anything goes wrong, the return value will instead an error message,
-as a string."
-  (let* ((file (pop path))
-        (buffer (find-file-noselect file))
-        (level 1)
-        (lmin 1)
-        (lmax 1)
-        limit re end found pos heading cnt)
-    (unless buffer (error "File not found :%s" file))
-    (with-current-buffer buffer
-      (save-excursion
-       (save-restriction
-         (widen)
-         (setq limit (point-max))
-         (goto-char (point-min))
-         (while (setq heading (pop path))
-           (setq re (format org-complex-heading-regexp-format
-                            (regexp-quote heading)))
-           (setq cnt 0 pos (point))
-           (while (re-search-forward re end t)
-             (setq level (- (match-end 1) (match-beginning 1)))
-             (if (and (>= level lmin) (<= level lmax))
-                 (setq found (match-beginning 0) cnt (1+ cnt))))
-           (when (= cnt 0) (error "Heading not found on level %d: %s"
-                                  lmax heading))
-           (when (> cnt 1) (error "Heading not unique on level %d: %s"
-                                  lmax heading))
-           (goto-char found)
-           (setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0)))
-           (setq end (save-excursion (org-end-of-subtree t t))))
-         (when (org-on-heading-p)
-           (move-marker (make-marker) (point))))))))
-
 (defun org-mobile-locate-entry (link)
   (if (string-match "\\`id:\\(.*\\)$" link)
       (org-id-find (match-string 1 link) 'marker)
@@ -856,7 +1002,7 @@ be returned that indicates what went wrong."
        (org-todo (or new 'none)) t)
        (t (error "State before change was expected as \"%s\", but is \"%s\""
                 old current))))
-      
+
      ((eq what 'tags)
       (setq current (org-get-tags)
            new1 (and new (org-split-string new ":+"))
@@ -869,7 +1015,7 @@ be returned that indicates what went wrong."
        (org-set-tags-to new1) t)
        (t (error "Tags before change were expected as \"%s\", but are \"%s\""
                 (or old "") (or current "")))))
-     
+
      ((eq what 'priority)
       (when (looking-at org-complex-heading-regexp)
        (setq current (and (match-end 3) (substring (match-string 3) 2 3)))
@@ -895,7 +1041,7 @@ be returned that indicates what went wrong."
          (delete-region (point) (+ (point) (length current)))
          (org-set-tags nil 'align))
         (t (error "Heading changed in MobileOrg and on the computer")))))
-     
+
      ((eq what 'body)
       (setq current (buffer-substring (min (1+ (point-at-eol)) (point-max))
                                      (save-excursion (outline-next-heading)
@@ -915,7 +1061,6 @@ be returned that indicates what went wrong."
                                        (point))))
        t)
        (t (error "Body was changed in MobileOrg and on the computer")))))))
-       
 
 (defun org-mobile-tags-same-p (list1 list2)
   "Are the two tag lists the same?"