lisp/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.30trans
   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.
  31
  32 (require 'org)
  33 (require 'org-agenda)
  34
  35 (defgroup org-mobile nil
  36   "Options concerning support for a viewer on a mobile device."
  37   :tag "Org Mobile"
  38   :group 'org)
  39
  40 (defcustom org-mobile-directory ""
  41   "The WebDAV directory where the interaction with the mobile takes place."
  42   :group 'org-mobile
  43   :type 'directory)
  44
  45 (defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org"
  46   "The file where captured notes and flags will be appended to.
  47 During the execution of `org-mobile-pull', the file
  48 `org-mobile-capture-file' will be emptied it's contents have
  49 been appended to the file given here."
  50   :group 'org-mobile
  51   :type 'file)
  52
  53 (defcustom org-mobile-capture-file "mobile-capture.org"
  54   "The capture file where the mobile stores captured notes and flags.
  55 Relative to `org-mobile-directory'."
  56   :group 'org-mobile
  57   :type 'file)
  58
  59 (defcustom org-mobile-index-file "index.org"
  60   "The index file with inks to all Org files that should be loaded by MobileOrg.
  61 Relative to `org-mobile-directory'."
  62   :group 'org-mobile
  63   :type 'file)
  64
  65 (defcustom org-mobile-force-id-on-agenda-items t
  66   "Non-nil means make all agenda items carry and ID."
  67   :group 'org-mobile
  68   :type 'boolean)
  69
  70 (defcustom org-mobile-action-alist
  71   '(("d" . (org-todo 'done))
  72     ("a" . (org-archive-subtree-default))
  73     ("d-a" . (progn (org-todo 'done) (org-archive-subtree-default))))
  74   "Alist with flags and actions for mobile sync.
  75 When flagging an entry, MobileOrg will create entries that look like
  76
  77   * F(action)  [[id:entry-id][entry title]]
  78
  79 This alist defines that the action in the parentheses of F() should mean,
  80 i.e. what action should be taken.  The car of each elements of the alist
  81 is an actions string.  The cdr is an Emacs Lisp form that will be evaluated
  82 with the cursor on the headline of that entry."
  83   :group 'org-mobile
  84   :type '(repeat
  85           (cons (string :tag "Action flag")
  86                 (sexp   :tag "Action form"))))
  87
  88 (defvar org-mobile-pre-push-hook nil
  89   "Hook run before running `org-mobile-push'.
  90 This could be used to clean up `org-mobile-directory', for example to
  91 remove files that used to be included in the agenda but no longer are.
  92 The presence of such files would not really be a problem, but after time
  93 they may accumulate.")
  94
  95 (defvar org-mobile-post-push-hook nil
  96   "Hook run after running `org-mobile-push'.
  97 If Emacs does not have direct write access to the WebDAV directory used
  98 by the mobile device, this hook could be used to copy all files from the
  99 local `org-mobile-directory' to the WebDAV directory, for example using
 100 `rsync' or `scp'.")
 101
 102 (defvar org-mobile-pre-pull-hook nil
 103   "Hook run before executing `org-mobile-pull'.
 104 If Emacs does not have direct write access to the WebDAV directory used
 105 by the mobile device, this hook could be used to copy all files from the
 106 WebDAV location to the local staging directory `org-mobile-directory'.")
 107
 108 (defvar org-mobile-post-pull-hook nil
 109   "Hook run after running `org-mobile-pull'.
 110 If Emacs does not have direct write access to the WebDAV directory used
 111 by the mobile device, this hook could be used to copy all files from the
 112 local `org-mobile-directory' to the WebDAV directory, for example using
 113 `rsync' or `scp'.  The only file that will be changed after a pull is
 114 `org-mobile-capture-file'.")
 115
 116 (defvar org-mobile-last-flagged-files nil
 117   "List of files containing entreis flagged in the latest pull.")
 118
 119 ;;;###autoload
 120 (defun org-mobile-push ()
 121   "Push the current state of Org affairs to the WebDAV directory.
 122 This will create the index file, copy all agenda files there, and also
 123 create all custom agenda views, for upload to the mobile phone."
 124   (interactive)
 125   (org-mobile-check-setup)
 126   (run-hooks 'org-mobile-pre-push-hook)
 127   (org-mobile-create-sumo-agenda)
 128   (org-save-all-org-buffers) ; to save any IDs created by this process
 129   (org-mobile-copy-agenda-files)
 130   (org-mobile-create-index-file)
 131   (org-mobile-write-checksums)
 132   (run-hooks 'org-mobile-post-push-hook)
 133   (message "Files for mobile viewer staged"))
 134
 135 ;;;###autoload
 136 (defun org-mobile-pull ()
 137   "Pull the contents of `org-mobile-capture-file' and integrate them.
 138 Apply all flagged actions, flag entries to be flagged and then call an
 139 agenda view showing the flagged items."
 140   (interactive)
 141   (org-mobile-check-setup)
 142   (run-hooks 'org-mobile-pre-pull-hook)
 143   (let ((insertion-marker (org-mobile-move-capture)))
 144     (if (not (markerp insertion-marker))
 145         (message "No new items")
 146       (org-with-point-at insertion-marker
 147         (org-mobile-apply-flags (point) (point-max)))
 148       (move-marker insertion-marker nil)
 149       (run-hooks 'org-mobile-post-pull-hook)
 150       (when org-mobile-last-flagged-files
 151         ;; Make an agenda view of flagged entries, but only in the files
 152         ;; where stuff has been added.
 153         (put 'org-agenda-files 'org-restrict org-mobile-last-flagged-files)
 154         (let ((org-agenda-keep-restriced-file-list t))
 155           (org-agenda nil "?"))))))
 156
 157 (defun org-mobile-check-setup ()
 158   "Check if org-mobile-directory has been set up."
 159   (when (or (not org-mobile-directory)
 160             (not (stringp org-mobile-directory))
 161             (not (string-match "\\S-" org-mobile-directory))
 162             (not (file-exists-p org-mobile-directory))
 163             (not (file-directory-p org-mobile-directory)))
 164     (error
 165      "Variable `org-mobile-directory' must point to an existing directory"))
 166   (when (or (not org-mobile-inbox-for-pull)
 167             (not (stringp org-mobile-inbox-for-pull))
 168             (not (string-match "\\S-" org-mobile-inbox-for-pull))
 169             (not (file-exists-p
 170                   (file-name-directory org-mobile-inbox-for-pull))))
 171     (error
 172      "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory")))
 173
 174 (defun org-mobile-create-index-file ()
 175   "Write the index file in the WebDAV directory."
 176   (interactive)
 177   (with-temp-file (expand-file-name org-mobile-index-file org-mobile-directory)
 178     (insert "* [[file:agendas.org][Agenda Views]]\n")
 179     (let ((files (org-agenda-files t)) file)
 180       (while (setq file (pop files))
 181         (insert (format "* [[file:%s][%s]]\n"
 182                         (file-name-nondirectory file)
 183                         (capitalize
 184                          (file-name-sans-extension
 185                           (file-name-nondirectory file))))))
 186       (insert (format "* [[file:%s][Captured before last sync]]\n"
 187                       (file-name-sans-extension org-mobile-capture-file))))))
 188
 189 (defun org-mobile-copy-agenda-files ()
 190   "Copy all agenda files to the stage or WebDAV directory."
 191   (let ((files (org-agenda-files t)) file)
 192     (while (setq file (pop files))
 193       (if (file-exists-p file)
 194           (copy-file file (expand-file-name (file-name-nondirectory file)
 195                                             org-mobile-directory)
 196                      'ok-if-exists)))))
 197
 198 (defun org-mobile-write-checksums ()
 199   "Create checksums for all files in `org-mobile-directory'.
 200 The table of checksums is written to the file mobile-checksums."
 201   (let ((cmd (cond ((executable-find "shasum"))
 202                    ((executable-find "sha1sum"))
 203                    ((executable-find "md5sum"))
 204                    ((executable-find "md5")))))
 205     (if (not cmd)
 206         (message "Checksums could not be generated: no executable")
 207       (with-temp-buffer
 208         (cd org-mobile-directory)
 209         (if (equal 0 (shell-command (concat cmd " *.org > checksums.dat")))
 210             (message "Checksums written")
 211           (message "Checksums could not be generated"))))))
 212
 213 (defun org-mobile-sumo-agenda-command ()
 214   "Return an agenda custom command that comprises all custom commands."
 215   (let ((custom-list
 216          ;; normalize different versions
 217          (delq nil
 218                (mapcar
 219                 (lambda (x)
 220                   (cond ((stringp (cdr x)) nil)
 221                         ((stringp (nth 1 x)) x)
 222                         ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
 223                         (t (cons (car x) (cons "" (cdr x))))))
 224                 org-agenda-custom-commands)))
 225         new e key desc type match settings cmds gkey gdesc gsettings cnt)
 226     (while (setq e (pop custom-list))
 227       (cond
 228        ((stringp (cdr e))
 229         ;; this is a description entry - skip it
 230         )
 231        ((eq (nth 2 e) 'search)
 232         ;; Search view is interactive, skip
 233         )
 234        ((memq (nth 2 e) '(todo-tree tags-tree occur-tree))
 235         ;; These are trees, not really agenda commands
 236         )
 237        ((memq (nth 2 e) '(agenda todo tags))
 238         ;; a normal command
 239         (setq key (car e) desc (nth 1 e) type (nth 2 e) match (nth 3 e)
 240               settings (nth 4 e))
 241         (setq settings
 242               (cons (list 'org-agenda-title-append
 243                           (concat "<break>KEYS=" key " TITLE: "
 244                                   (if (and (stringp desc) (> (length desc) 0))
 245                                       desc (symbol-name type))
 246                                   " " match))
 247                     settings))
 248         (push (list type match settings) new))
 249        ((symbolp (nth 2 e))
 250         ;; A user-defined function, not sure how to handle that yet
 251         )
 252        (t
 253         ;; a block agenda
 254         (setq gkey (car e) gdesc (nth 1 e) gsettings (nth 3 e) cmds (nth 2 e))
 255         (setq cnt 0)
 256         (while (setq e (pop cmds))
 257           (setq type (car e) match (nth 1 e) settings (nth 2 e))
 258           (setq settings (append gsettings settings))
 259           (setq settings
 260                 (cons (list 'org-agenda-title-append
 261                             (concat "<break>KEYS=" gkey "#" (number-to-string
 262                                                       (setq cnt (1+ cnt)))
 263                                     " TITLE: " gdesc " " match))
 264                       settings))
 265           (push (list type match settings) new)))))
 266     (list "X" "SUMO" (reverse new) nil)))
 267
 268 ;;;###autoload
 269 (defun org-mobile-create-sumo-agenda ()
 270   "Create a file that contains all custom agenda views."
 271   (interactive)
 272   (let* ((file (expand-file-name "agendas.org"
 273                                  org-mobile-directory))
 274          (org-agenda-custom-commands
 275           (list (append (org-mobile-sumo-agenda-command)
 276                         (list (list file))))))
 277     (unless (file-writable-p file)
 278       (error "Cannot write to file %s" file))
 279     (org-batch-store-agenda-views)))
 280
 281 (defun org-mobile-move-capture ()
 282   "Move the contents of the capture file to the inbox file.
 283 Return a marker to the location where the new content has been added.
 284 If nothing new has beed added, return nil."
 285   (interactive)
 286   (let ((inbox-buffer (find-file-noselect org-mobile-inbox-for-pull))
 287         (capture-buffer (find-file-noselect
 288                          (expand-file-name org-mobile-capture-file
 289                                            org-mobile-directory)))
 290         (insertion-point (make-marker))
 291         not-empty content)
 292     (save-excursion
 293       (set-buffer capture-buffer)
 294       (setq content (buffer-string))
 295       (setq not-empty (string-match "\\S-" content))
 296       (when not-empty
 297         (set-buffer inbox-buffer)
 298         (widen)
 299         (goto-char (point-max))
 300         (or (bolp) (newline))
 301         (move-marker insertion-point
 302                      (prog1 (point) (insert content)))
 303         (save-buffer)
 304         (set-buffer capture-buffer)
 305         (erase-buffer)
 306         (save-buffer)))
 307     (kill-buffer capture-buffer)
 308     (if not-empty insertion-point)))
 309
 310 (defun org-mobile-apply-flags (&optional beg end)
 311   "Apply all flags in the current buffer.
 312 If BEG and END are given, only do this in that region."
 313   (interactive)
 314   (setq org-mobile-last-flagged-files nil)
 315   (setq beg (or beg (point-min)) end (or end (point-max)))
 316   (goto-char beg)
 317   (let ((marker (make-marker))
 318         (end (move-marker (make-marker) end))
 319         action id id-pos cmd text)
 320     (while (re-search-forward
 321             "^\\*+[ \t]+F(\\([^()\n]*\\))[ \t]+\\[\\[id:\\([^]\n ]+\\)" end t)
 322       (goto-char (- (match-beginning 1) 2))
 323       (catch 'next
 324         (setq action (match-string 1)
 325               id (match-string 2)
 326               cmd (if (equal action "")
 327                       '(progn
 328                          (org-toggle-tag "FLAGGED" 'on)
 329                          (and text (org-entry-put nil "THEFLAGGINGNOTE" text)))
 330                     (cdr (assoc action org-mobile-action-alist)))
 331               text (org-trim (buffer-substring (1+ (point-at-eol))
 332                                                (save-excursion
 333                                                  (org-end-of-subtree t))))
 334               id-pos (org-id-find id 'marker))
 335         (if (> (length text) 0)
 336             ;; Make TEXT into a single line, to fit into a property
 337             (setq text (mapconcat 'identity
 338                                   (org-split-string text "\n")
 339                                   "\\n"))
 340           (setq text nil))
 341         (unless id-pos
 342           (insert "BAD ID REFERENCE ")
 343           (throw 'next t))
 344         (unless cmd
 345           (insert "BAD FLAG ")
 346           (throw 'next t))
 347         (move-marker marker (point))
 348         (save-excursion
 349           (condition-case nil
 350               (org-with-point-at id-pos
 351                 (progn
 352                   (eval cmd)
 353                   (if (member "FLAGGED" (org-get-tags))
 354                       (add-to-list 'org-mobile-last-flagged-files
 355                                    (buffer-file-name (current-buffer))))))
 356             (error
 357              (progn
 358                (switch-to-buffer (marker-buffer marker))
 359                (goto-char marker)
 360                (insert "EXECUTION FAILED ")
 361                (throw 'next t)))))
 362         ;; If we get here, the action has been applied successfully
 363         ;; So remove the entry
 364         (org-back-to-heading t)
 365         (delete-region (point) (org-end-of-subtree t t))))
 366     (move-marker marker nil)
 367     (move-marker end nil)))
 368
 369 (defun org-mobile-smart-read ()
 370   "Parse the entry at point for shortcuts and expand them.
 371 These shortcuts are meant for fast and easy typing on the limited
 372 keyboards of a mobile device.  Below we show a list of the shortcuts
 373 currently implemented.
 374
 375 The entry is expected to contain an inactive time stamp indicating when
 376 the entry was created.  When setting dates and
 377 times (for example for deadlines), the time strings are interpreted
 378 relative to that creation date.
 379 Abbreviations are expected to take up entire lines, jst because it is so
 380 easy to type RET on a mobile device.  Abbreviations start with one or two
 381 letters, followed immediately by a dot and then additional information.
 382 Generally the entire shortcut line is removed after action have been taken.
 383 Time stamps will be constructed using `org-read-date'.  So for example a
 384 line \"dd. 2tue\" will set a deadline on the second Tuesday after the
 385 creation date.
 386
 387 Here are the shortcuts currently implemented:
 388
 389 dd. string             set deadline
 390 ss. string             set scheduling
 391 tt. string             set time tamp, here.
 392 ti. string             set inactive time
 393
 394 tg. tag1 tag2 tag3     set all these tags, change case where necessary
 395 td. kwd                set this todo keyword, change case where necessary
 396
 397 FIXME: Hmmm, not sure if we can make his work against the
 398 auto-correction feature.  Needs a bit more thinking.  So this function
 399 is currently a noop.")
 400
 401 (provide 'org-mobile)
 402
 403 ;; arch-tag: ace0e26c-58f2-4309-8a61-05ec1535f658
 404
 405 ;;; org-mobile.el ends here
 406