lisp/org/org-mobile.el

   1 ;;; org-mobile.el --- Code for asymmetric sync with a mobile device
   2 ;; Copyright (C) 2009 Free Software Foundation, Inc.
   3 ;;
   4 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   5 ;; Keywords: outlines, hypermedia, calendar, wp
   6 ;; Homepage: http://orgmode.org
   7 ;; Version: 6.31a
   8 ;;
   9 ;; This file is part of GNU Emacs.
  10 ;;
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15 ;;
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23 ;;
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25 ;;
  26 ;;; Commentary:
  27 ;;
  28 ;; This file contains the code to interact with Richard Moreland's iPhone
  29 ;; application MobileOrg.  This code is documented in Appendix B of the
  30 ;; Org-mode manual.  The code is not specific for the iPhone, however.
  31 ;; Any external viewer and flagging application that uses the same
  32 ;; conventions could be used.
  33
  34 (require 'org)
  35 (require 'org-agenda)
  36
  37 (defgroup org-mobile nil
  38   "Options concerning support for a viewer on a mobile device."
  39   :tag "Org Mobile"
  40   :group 'org)
  41
  42 (defcustom org-mobile-files '(org-agenda-files)
  43   "Files to be staged for MobileOrg.
  44 This is basically a list of filesand directories.  Files will be staged
  45 directly.  Directories will be search for files with the extension `.org'.
  46 In addition to this, the list may also contain the following symbols:
  47
  48 org-agenda-files
  49      This means, include the complete, unrestricted list of files given in
  50      the variable `org-agenda-files'.
  51 org-agenda-text-search-extra-files
  52      Include the files given in the variable
  53      `org-agenda-text-search-extra-files'"
  54   :group 'org-mobile
  55   :type '(list :greedy t
  56                (option (const :tag "org-agenda-files" org-agenda-files))
  57                (option (const :tag "org-agenda-text-search-extra-files"
  58                               org-agenda-text-search-extra-files))
  59                (repeat :inline t :tag "Additional files"
  60                        (file))))
  61
  62 (defcustom org-mobile-directory ""
  63   "The WebDAV directory where the interaction with the mobile takes place."
  64   :group 'org-mobile
  65   :type 'directory)
  66
  67 (defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org"
  68   "The file where captured notes and flags will be appended to.
  69 During the execution of `org-mobile-pull', the file
  70 `org-mobile-capture-file' will be emptied it's contents have
  71 been appended to the file given here."
  72   :group 'org-mobile
  73   :type 'file)
  74
  75 (defconst org-mobile-capture-file "mobileorg.org"
  76   "The capture file where the mobile stores captured notes and flags.
  77 This should not be changed, because MobileOrg assumes this name.")
  78
  79 (defcustom org-mobile-index-file "index.org"
  80   "The index file with inks to all Org files that should be loaded by MobileOrg.
  81 Relative to `org-mobile-directory'.  The Address field in the MobileOrg setup
  82 should point to this file."
  83   :group 'org-mobile
  84   :type 'file)
  85
  86 (defcustom org-mobile-force-id-on-agenda-items t
  87   "Non-nil means make all agenda items carry and ID."
  88   :group 'org-mobile
  89   :type 'boolean)
  90
  91 (defcustom org-mobile-action-alist
  92   '(("d" . (org-todo 'done))
  93     ("a" . (org-archive-subtree-default))
  94     ("d-a" . (progn (org-todo 'done) (org-archive-subtree-default)))
  95     ("todo" . (org-todo data))
  96     ("tags" . (org-set-tags-to data)))
  97   "Alist with flags and actions for mobile sync.
  98 When flagging an entry, MobileOrg will create entries that look like
  99
 100   * F(action:data)  [[id:entry-id][entry title]]
 101
 102 This alist defines that the ACTION in the parentheses of F() should mean,
 103 i.e. what action should be taken.  The :data part in the parenthesis is
 104 optional.  If present, the string after the colon will be passed to the
 105 action form as the `data' variable.
 106 The car of each elements of the alist is an actions string.  The cdr is
 107 an Emacs Lisp form that will be evaluated with the cursor on the headline
 108 of that entry."
 109   :group 'org-mobile
 110   :type '(repeat
 111           (cons (string :tag "Action flag")
 112                 (sexp   :tag "Action form"))))
 113
 114 (defvar org-mobile-pre-push-hook nil
 115   "Hook run before running `org-mobile-push'.
 116 This could be used to clean up `org-mobile-directory', for example to
 117 remove files that used to be included in the agenda but no longer are.
 118 The presence of such files would not really be a problem, but after time
 119 they may accumulate.")
 120
 121 (defvar org-mobile-post-push-hook nil
 122   "Hook run after running `org-mobile-push'.
 123 If Emacs does not have direct write access to the WebDAV directory used
 124 by the mobile device, this hook should be used to copy all files from the
 125 local staging directory `org-mobile-directory' to the WebDAV directory,
 126 for example using `rsync' or `scp'.")
 127
 128 (defvar org-mobile-pre-pull-hook nil
 129   "Hook run before executing `org-mobile-pull'.
 130 If Emacs does not have direct write access to the WebDAV directory used
 131 by the mobile device, this hook should be used to copy the capture file
 132 `mobileorg.org' from the WebDAV location to the local staging
 133 directory `org-mobile-directory'.")
 134
 135 (defvar org-mobile-post-pull-hook nil
 136   "Hook run after running `org-mobile-pull'.
 137 If Emacs does not have direct write access to the WebDAV directory used
 138 by the mobile device, this hook should be used to copy the emptied
 139 capture file `mobileorg.org' back to the WebDAV directory, for example
 140 using `rsync' or `scp'.")
 141
 142 (defvar org-mobile-last-flagged-files nil
 143   "List of files containing entreis flagged in the latest pull.")
 144
 145 (defvar org-mobile-files-alist nil)
 146 (defvar org-mobile-checksum-files nil)
 147
 148 (defun org-mobile-prepare-file-lists ()
 149   (setq org-mobile-files-alist (org-mobile-files-alist))
 150   (setq org-mobile-checksum-files (mapcar 'cdr org-mobile-files-alist)))
 151
 152 (defun org-mobile-files-alist ()
 153   "Expand the list in `org-mobile-files' to a list of existing files."
 154   (let* ((files
 155           (apply 'append (mapcar
 156                           (lambda (f)
 157                             (cond
 158                              ((eq f 'org-agenda-files) (org-agenda-files t))
 159                              ((eq f 'org-agenda-text-search-extra-files)
 160                               org-agenda-text-search-extra-files)
 161                              ((and (stringp f) (file-directory-p f))
 162                               (directory-files f 'full "\\.org\\'"))
 163                              ((and (stringp f) (file-exists-p f))
 164                               (list f))
 165                              (t nil)))
 166                           org-mobile-files)))
 167          (orgdir-uname (file-name-as-directory (file-truename org-directory)))
 168          (orgdir-re (concat "\\`" (regexp-quote orgdir-uname)))
 169          uname seen rtn file link-name)
 170     ;; Make the files unique, and determine the name under which they will
 171     ;; be listed.
 172     (while (setq file (pop files))
 173       (setq uname (file-truename file))
 174       (unless (member uname seen)
 175         (push uname seen)
 176         (if (string-match orgdir-re uname)
 177             (setq link-name (substring uname (match-end 0)))
 178           (setq link-name (file-name-nondirectory uname)))
 179         (push (cons file link-name) rtn)))
 180     (nreverse rtn)))
 181
 182 ;;;###autoload
 183 (defun org-mobile-push ()
 184   "Push the current state of Org affairs to the WebDAV directory.
 185 This will create the index file, copy all agenda files there, and also
 186 create all custom agenda views, for upload to the mobile phone."
 187   (interactive)
 188   (org-mobile-check-setup)
 189   (org-mobile-prepare-file-lists)
 190   (run-hooks 'org-mobile-pre-push-hook)
 191   (org-mobile-create-sumo-agenda)
 192   (org-save-all-org-buffers) ; to save any IDs created by this process
 193   (org-mobile-copy-agenda-files)
 194   (org-mobile-create-index-file)
 195   (org-mobile-write-checksums)
 196   (run-hooks 'org-mobile-post-push-hook)
 197   (message "Files for mobile viewer staged"))
 198
 199 ;;;###autoload
 200 (defun org-mobile-pull ()
 201   "Pull the contents of `org-mobile-capture-file' and integrate them.
 202 Apply all flagged actions, flag entries to be flagged and then call an
 203 agenda view showing the flagged items."
 204   (interactive)
 205   (org-mobile-check-setup)
 206   (run-hooks 'org-mobile-pre-pull-hook)
 207   (let ((insertion-marker (org-mobile-move-capture)))
 208     (if (not (markerp insertion-marker))
 209         (message "No new items")
 210       (org-with-point-at insertion-marker
 211         (org-mobile-apply-flags (point) (point-max)))
 212       (move-marker insertion-marker nil)
 213       (run-hooks 'org-mobile-post-pull-hook)
 214       (when org-mobile-last-flagged-files
 215         ;; Make an agenda view of flagged entries, but only in the files
 216         ;; where stuff has been added.
 217         (put 'org-agenda-files 'org-restrict org-mobile-last-flagged-files)
 218         (let ((org-agenda-keep-restriced-file-list t))
 219           (org-agenda nil "?"))))))
 220
 221 (defun org-mobile-check-setup ()
 222   "Check if org-mobile-directory has been set up."
 223   (when (or (not org-mobile-directory)
 224             (not (stringp org-mobile-directory))
 225             (not (string-match "\\S-" org-mobile-directory))
 226             (not (file-exists-p org-mobile-directory))
 227             (not (file-directory-p org-mobile-directory)))
 228     (error
 229      "Variable `org-mobile-directory' must point to an existing directory"))
 230   (when (or (not org-mobile-inbox-for-pull)
 231             (not (stringp org-mobile-inbox-for-pull))
 232             (not (string-match "\\S-" org-mobile-inbox-for-pull))
 233             (not (file-exists-p
 234                   (file-name-directory org-mobile-inbox-for-pull))))
 235     (error
 236      "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory")))
 237
 238 (defun org-mobile-create-index-file ()
 239   "Write the index file in the WebDAV directory."
 240   (let ((files-alist org-mobile-files-alist)
 241         file link-name todo-kwds done-kwds tags drawers entry)
 242     (org-prepare-agenda-buffers (mapcar 'car files-alist))
 243     (setq done-kwds (org-uniquify org-done-keywords-for-agenda))
 244     (setq todo-kwds (org-delete-all
 245                      done-kwds
 246                      (org-uniquify org-todo-keywords-for-agenda)))
 247     (setq drawers (org-uniquify org-drawers-for-agenda))
 248     (setq tags (org-uniquify
 249                 (delq nil
 250                       (mapcar
 251                        (lambda (e)
 252                          (cond ((stringp e) e)
 253                                ((listp e)
 254                                 (if (stringp (car e)) (car e) nil))
 255                                (t nil)))
 256                        org-tag-alist-for-agenda))))
 257     (with-temp-file
 258         (expand-file-name org-mobile-index-file org-mobile-directory)
 259       (insert "#+TODO: " (mapconcat 'identity todo-kwds " ") " | "
 260               (mapconcat 'identity done-kwds " ") "\n"
 261               "#+TAGS: " (mapconcat 'identity tags " ") "\n"
 262               "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n")
 263       (insert "* [[file:agendas.org][Agenda Views]]\n")
 264       (while (setq entry (pop files-alist))
 265         (setq file (car entry)
 266               link-name (cdr entry))
 267         (insert (format "* [[file:%s][%s]]\n"
 268                         link-name link-name)))
 269       (insert (format "* [[file:%s][Captured before last sync]]\n"
 270                       org-mobile-capture-file)))))
 271
 272 (defun org-mobile-copy-agenda-files ()
 273   "Copy all agenda files to the stage or WebDAV directory."
 274   (let ((files-alist org-mobile-files-alist)
 275         file buf entry link-name target-path target-dir)
 276     (while (setq entry (pop files-alist))
 277       (setq file (car entry) link-name (cdr entry))
 278       (when (file-exists-p file)
 279         (setq target-path (expand-file-name link-name org-mobile-directory)
 280               target-dir (file-name-directory target-path))
 281         (unless (file-directory-p target-dir)
 282           (make-directory target-dir 'parents)
 283           (copy-file file target-path 'ok-if-exists))))
 284     (setq file (expand-file-name org-mobile-capture-file
 285                                  org-mobile-directory))
 286     (unless (file-exists-p file)
 287       (save-excursion
 288         (setq buf (find-file file))
 289         (insert "\n")
 290         (save-buffer))
 291       (kill-buffer buf))))
 292
 293 (defun org-mobile-write-checksums ()
 294   "Create checksums for all files in `org-mobile-directory'.
 295 The table of checksums is written to the file mobile-checksums."
 296   (let ((cmd (cond ((executable-find "shasum"))
 297                    ((executable-find "sha1sum"))
 298                    ((executable-find "md5sum"))
 299                    ((executable-find "md5"))))
 300         (files org-mobile-checksum-files))
 301     (if (not cmd)
 302         (message "Checksums could not be generated: no executable")
 303       (with-temp-buffer
 304         (cd org-mobile-directory)
 305         (if (file-exists-p "agendas.org")
 306             (push "agendas.org" files))
 307         (if (file-exists-p "mobileorg.org")
 308             (push "mobileorg.org" files))
 309         (setq cmd (concat cmd " " (mapconcat 'shell-quote-argument files " ")
 310                           " > checksums.dat"))
 311         (if (equal 0 (shell-command cmd))
 312             (message "Checksums written")
 313           (message "Checksums could not be generated"))))))
 314
 315 (defun org-mobile-sumo-agenda-command ()
 316   "Return an agenda custom command that comprises all custom commands."
 317   (let ((custom-list
 318          ;; normalize different versions
 319          (delq nil
 320                (mapcar
 321                 (lambda (x)
 322                   (cond ((stringp (cdr x)) nil)
 323                         ((stringp (nth 1 x)) x)
 324                         ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
 325                         (t (cons (car x) (cons "" (cdr x))))))
 326                 org-agenda-custom-commands)))
 327         new e key desc type match settings cmds gkey gdesc gsettings cnt)
 328     (while (setq e (pop custom-list))
 329       (cond
 330        ((stringp (cdr e))
 331         ;; this is a description entry - skip it
 332         )
 333        ((eq (nth 2 e) 'search)
 334         ;; Search view is interactive, skip
 335         )
 336        ((memq (nth 2 e) '(todo-tree tags-tree occur-tree))
 337         ;; These are trees, not really agenda commands
 338         )
 339        ((memq (nth 2 e) '(agenda todo tags))
 340         ;; a normal command
 341         (setq key (car e) desc (nth 1 e) type (nth 2 e) match (nth 3 e)
 342               settings (nth 4 e))
 343         (setq settings
 344               (cons (list 'org-agenda-title-append
 345                           (concat "<break>KEYS=" key " TITLE: "
 346                                   (if (and (stringp desc) (> (length desc) 0))
 347                                       desc (symbol-name type))
 348                                   " " match))
 349                     settings))
 350         (push (list type match settings) new))
 351        ((symbolp (nth 2 e))
 352         ;; A user-defined function, not sure how to handle that yet
 353         )
 354        (t
 355         ;; a block agenda
 356         (setq gkey (car e) gdesc (nth 1 e) gsettings (nth 3 e) cmds (nth 2 e))
 357         (setq cnt 0)
 358         (while (setq e (pop cmds))
 359           (setq type (car e) match (nth 1 e) settings (nth 2 e))
 360           (setq settings (append gsettings settings))
 361           (setq settings
 362                 (cons (list 'org-agenda-title-append
 363                             (concat "<break>KEYS=" gkey "#" (number-to-string
 364                                                       (setq cnt (1+ cnt)))
 365                                     " TITLE: " gdesc " " match))
 366                       settings))
 367           (push (list type match settings) new)))))
 368     (list "X" "SUMO" (reverse new) nil)))
 369
 370 ;;;###autoload
 371 (defun org-mobile-create-sumo-agenda ()
 372   "Create a file that contains all custom agenda views."
 373   (interactive)
 374   (let* ((file (expand-file-name "agendas.org"
 375                                  org-mobile-directory))
 376          (org-agenda-custom-commands
 377           (list (append (org-mobile-sumo-agenda-command)
 378                         (list (list file))))))
 379     (unless (file-writable-p file)
 380       (error "Cannot write to file %s" file))
 381     (org-store-agenda-views)))
 382
 383 (defun org-mobile-move-capture ()
 384   "Move the contents of the capture file to the inbox file.
 385 Return a marker to the location where the new content has been added.
 386 If nothing new has beed added, return nil."
 387   (interactive)
 388   (let ((inbox-buffer (find-file-noselect org-mobile-inbox-for-pull))
 389         (capture-buffer (find-file-noselect
 390                          (expand-file-name org-mobile-capture-file
 391                                            org-mobile-directory)))
 392         (insertion-point (make-marker))
 393         not-empty content)
 394     (save-excursion
 395       (set-buffer capture-buffer)
 396       (setq content (buffer-string))
 397       (setq not-empty (string-match "\\S-" content))
 398       (when not-empty
 399         (set-buffer inbox-buffer)
 400         (widen)
 401         (goto-char (point-max))
 402         (or (bolp) (newline))
 403         (move-marker insertion-point
 404                      (prog1 (point) (insert content)))
 405         (save-buffer)
 406         (set-buffer capture-buffer)
 407         (erase-buffer)
 408         (save-buffer)))
 409     (kill-buffer capture-buffer)
 410     (if not-empty insertion-point)))
 411
 412 (defun org-mobile-apply-flags (&optional beg end)
 413   "Apply all flags in the current buffer.
 414 If BEG and END are given, only do this in that region."
 415   (interactive)
 416   (require 'org-archive)
 417   (setq org-mobile-last-flagged-files nil)
 418   (setq beg (or beg (point-min)) end (or end (point-max)))
 419   (goto-char beg)
 420   (let ((marker (make-marker))
 421         (org-inhibit-logging 'note)
 422         (end (move-marker (make-marker) end))
 423         action data id id-pos cmd text)
 424     (while (re-search-forward
 425             "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[id:\\([^]\n ]+\\)" end t)
 426       (goto-char (- (match-beginning 1) 2))
 427       (catch 'next
 428         (setq action (match-string 1)
 429               data (and (match-end 3) (match-string 3))
 430               id (match-string 4)
 431               cmd (if (equal action "")
 432                       '(progn
 433                          (org-toggle-tag "FLAGGED" 'on)
 434                          (and text (org-entry-put nil "THEFLAGGINGNOTE" text)))
 435                     (cdr (assoc action org-mobile-action-alist)))
 436               text (org-trim (buffer-substring (1+ (point-at-eol))
 437                                                (save-excursion
 438                                                  (org-end-of-subtree t))))
 439               id-pos (org-id-find id 'marker))
 440         (if (> (length text) 0)
 441             ;; Make TEXT into a single line, to fit into a property
 442             (setq text (mapconcat 'identity
 443                                   (org-split-string text "\n")
 444                                   "\\n"))
 445           (setq text nil))
 446         (unless id-pos
 447           (insert "BAD ID REFERENCE ")
 448           (throw 'next t))
 449         (unless cmd
 450           (insert "BAD FLAG ")
 451           (throw 'next t))
 452         (move-marker marker (point))
 453         (save-excursion
 454           (condition-case nil
 455               (org-with-point-at id-pos
 456                 (progn
 457                   (eval cmd)
 458                   (if (member "FLAGGED" (org-get-tags))
 459                       (add-to-list 'org-mobile-last-flagged-files
 460                                    (buffer-file-name (current-buffer))))))
 461             (error
 462              (progn
 463                (switch-to-buffer (marker-buffer marker))
 464                (goto-char marker)
 465                (insert "EXECUTION FAILED ")
 466                (throw 'next t)))))
 467         ;; If we get here, the action has been applied successfully
 468         ;; So remove the entry
 469         (org-back-to-heading t)
 470         (delete-region (point) (org-end-of-subtree t t))))
 471     (move-marker marker nil)
 472     (move-marker end nil)))
 473
 474 (defun org-mobile-smart-read ()
 475   "Parse the entry at point for shortcuts and expand them.
 476 These shortcuts are meant for fast and easy typing on the limited
 477 keyboards of a mobile device.  Below we show a list of the shortcuts
 478 currently implemented.
 479
 480 The entry is expected to contain an inactive time stamp indicating when
 481 the entry was created.  When setting dates and
 482 times (for example for deadlines), the time strings are interpreted
 483 relative to that creation date.
 484 Abbreviations are expected to take up entire lines, jst because it is so
 485 easy to type RET on a mobile device.  Abbreviations start with one or two
 486 letters, followed immediately by a dot and then additional information.
 487 Generally the entire shortcut line is removed after action have been taken.
 488 Time stamps will be constructed using `org-read-date'.  So for example a
 489 line \"dd. 2tue\" will set a deadline on the second Tuesday after the
 490 creation date.
 491
 492 Here are the shortcuts currently implemented:
 493
 494 dd. string             set deadline
 495 ss. string             set scheduling
 496 tt. string             set time tamp, here.
 497 ti. string             set inactive time
 498
 499 tg. tag1 tag2 tag3     set all these tags, change case where necessary
 500 td. kwd                set this todo keyword, change case where necessary
 501
 502 FIXME: Hmmm, not sure if we can make his work against the
 503 auto-correction feature.  Needs a bit more thinking.  So this function
 504 is currently a noop.")
 505
 506 (provide 'org-mobile)
 507
 508 ;; arch-tag: ace0e26c-58f2-4309-8a61-05ec1535f658
 509
 510 ;;; org-mobile.el ends here
 511