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                       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 buf)
 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     (setq file (expand-file-name org-mobile-capture-file
 198                                  org-mobile-directory))
 199     (unless (file-exists-p file)
 200       (save-excursion
 201         (setq buf (find-file file))
 202         (insert "\n")
 203         (save-buffer)
 204       (kill-buffer buf)))))
 205
 206 (defun org-mobile-write-checksums ()
 207   "Create checksums for all files in `org-mobile-directory'.
 208 The table of checksums is written to the file mobile-checksums."
 209   (let ((cmd (cond ((executable-find "shasum"))
 210                    ((executable-find "sha1sum"))
 211                    ((executable-find "md5sum"))
 212                    ((executable-find "md5")))))
 213     (if (not cmd)
 214         (message "Checksums could not be generated: no executable")
 215       (with-temp-buffer
 216         (cd org-mobile-directory)
 217         (if (equal 0 (shell-command (concat cmd " *.org > checksums.dat")))
 218             (message "Checksums written")
 219           (message "Checksums could not be generated"))))))
 220
 221 (defun org-mobile-sumo-agenda-command ()
 222   "Return an agenda custom command that comprises all custom commands."
 223   (let ((custom-list
 224          ;; normalize different versions
 225          (delq nil
 226                (mapcar
 227                 (lambda (x)
 228                   (cond ((stringp (cdr x)) nil)
 229                         ((stringp (nth 1 x)) x)
 230                         ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
 231                         (t (cons (car x) (cons "" (cdr x))))))
 232                 org-agenda-custom-commands)))
 233         new e key desc type match settings cmds gkey gdesc gsettings cnt)
 234     (while (setq e (pop custom-list))
 235       (cond
 236        ((stringp (cdr e))
 237         ;; this is a description entry - skip it
 238         )
 239        ((eq (nth 2 e) 'search)
 240         ;; Search view is interactive, skip
 241         )
 242        ((memq (nth 2 e) '(todo-tree tags-tree occur-tree))
 243         ;; These are trees, not really agenda commands
 244         )
 245        ((memq (nth 2 e) '(agenda todo tags))
 246         ;; a normal command
 247         (setq key (car e) desc (nth 1 e) type (nth 2 e) match (nth 3 e)
 248               settings (nth 4 e))
 249         (setq settings
 250               (cons (list 'org-agenda-title-append
 251                           (concat "<break>KEYS=" key " TITLE: "
 252                                   (if (and (stringp desc) (> (length desc) 0))
 253                                       desc (symbol-name type))
 254                                   " " match))
 255                     settings))
 256         (push (list type match settings) new))
 257        ((symbolp (nth 2 e))
 258         ;; A user-defined function, not sure how to handle that yet
 259         )
 260        (t
 261         ;; a block agenda
 262         (setq gkey (car e) gdesc (nth 1 e) gsettings (nth 3 e) cmds (nth 2 e))
 263         (setq cnt 0)
 264         (while (setq e (pop cmds))
 265           (setq type (car e) match (nth 1 e) settings (nth 2 e))
 266           (setq settings (append gsettings settings))
 267           (setq settings
 268                 (cons (list 'org-agenda-title-append
 269                             (concat "<break>KEYS=" gkey "#" (number-to-string
 270                                                       (setq cnt (1+ cnt)))
 271                                     " TITLE: " gdesc " " match))
 272                       settings))
 273           (push (list type match settings) new)))))
 274     (list "X" "SUMO" (reverse new) nil)))
 275
 276 ;;;###autoload
 277 (defun org-mobile-create-sumo-agenda ()
 278   "Create a file that contains all custom agenda views."
 279   (interactive)
 280   (let* ((file (expand-file-name "agendas.org"
 281                                  org-mobile-directory))
 282          (org-agenda-custom-commands
 283           (list (append (org-mobile-sumo-agenda-command)
 284                         (list (list file))))))
 285     (unless (file-writable-p file)
 286       (error "Cannot write to file %s" file))
 287     (org-batch-store-agenda-views)))
 288
 289 (defun org-mobile-move-capture ()
 290   "Move the contents of the capture file to the inbox file.
 291 Return a marker to the location where the new content has been added.
 292 If nothing new has beed added, return nil."
 293   (interactive)
 294   (let ((inbox-buffer (find-file-noselect org-mobile-inbox-for-pull))
 295         (capture-buffer (find-file-noselect
 296                          (expand-file-name org-mobile-capture-file
 297                                            org-mobile-directory)))
 298         (insertion-point (make-marker))
 299         not-empty content)
 300     (save-excursion
 301       (set-buffer capture-buffer)
 302       (setq content (buffer-string))
 303       (setq not-empty (string-match "\\S-" content))
 304       (when not-empty
 305         (set-buffer inbox-buffer)
 306         (widen)
 307         (goto-char (point-max))
 308         (or (bolp) (newline))
 309         (move-marker insertion-point
 310                      (prog1 (point) (insert content)))
 311         (save-buffer)
 312         (set-buffer capture-buffer)
 313         (erase-buffer)
 314         (save-buffer)))
 315     (kill-buffer capture-buffer)
 316     (if not-empty insertion-point)))
 317
 318 (defun org-mobile-apply-flags (&optional beg end)
 319   "Apply all flags in the current buffer.
 320 If BEG and END are given, only do this in that region."
 321   (interactive)
 322   (setq org-mobile-last-flagged-files nil)
 323   (setq beg (or beg (point-min)) end (or end (point-max)))
 324   (goto-char beg)
 325   (let ((marker (make-marker))
 326         (end (move-marker (make-marker) end))
 327         action id id-pos cmd text)
 328     (while (re-search-forward
 329             "^\\*+[ \t]+F(\\([^()\n]*\\))[ \t]+\\[\\[id:\\([^]\n ]+\\)" end t)
 330       (goto-char (- (match-beginning 1) 2))
 331       (catch 'next
 332         (setq action (match-string 1)
 333               id (match-string 2)
 334               cmd (if (equal action "")
 335                       '(progn
 336                          (org-toggle-tag "FLAGGED" 'on)
 337                          (and text (org-entry-put nil "THEFLAGGINGNOTE" text)))
 338                     (cdr (assoc action org-mobile-action-alist)))
 339               text (org-trim (buffer-substring (1+ (point-at-eol))
 340                                                (save-excursion
 341                                                  (org-end-of-subtree t))))
 342               id-pos (org-id-find id 'marker))
 343         (if (> (length text) 0)
 344             ;; Make TEXT into a single line, to fit into a property
 345             (setq text (mapconcat 'identity
 346                                   (org-split-string text "\n")
 347                                   "\\n"))
 348           (setq text nil))
 349         (unless id-pos
 350           (insert "BAD ID REFERENCE ")
 351           (throw 'next t))
 352         (unless cmd
 353           (insert "BAD FLAG ")
 354           (throw 'next t))
 355         (move-marker marker (point))
 356         (save-excursion
 357           (condition-case nil
 358               (org-with-point-at id-pos
 359                 (progn
 360                   (eval cmd)
 361                   (if (member "FLAGGED" (org-get-tags))
 362                       (add-to-list 'org-mobile-last-flagged-files
 363                                    (buffer-file-name (current-buffer))))))
 364             (error
 365              (progn
 366                (switch-to-buffer (marker-buffer marker))
 367                (goto-char marker)
 368                (insert "EXECUTION FAILED ")
 369                (throw 'next t)))))
 370         ;; If we get here, the action has been applied successfully
 371         ;; So remove the entry
 372         (org-back-to-heading t)
 373         (delete-region (point) (org-end-of-subtree t t))))
 374     (move-marker marker nil)
 375     (move-marker end nil)))
 376
 377 (defun org-mobile-smart-read ()
 378   "Parse the entry at point for shortcuts and expand them.
 379 These shortcuts are meant for fast and easy typing on the limited
 380 keyboards of a mobile device.  Below we show a list of the shortcuts
 381 currently implemented.
 382
 383 The entry is expected to contain an inactive time stamp indicating when
 384 the entry was created.  When setting dates and
 385 times (for example for deadlines), the time strings are interpreted
 386 relative to that creation date.
 387 Abbreviations are expected to take up entire lines, jst because it is so
 388 easy to type RET on a mobile device.  Abbreviations start with one or two
 389 letters, followed immediately by a dot and then additional information.
 390 Generally the entire shortcut line is removed after action have been taken.
 391 Time stamps will be constructed using `org-read-date'.  So for example a
 392 line \"dd. 2tue\" will set a deadline on the second Tuesday after the
 393 creation date.
 394
 395 Here are the shortcuts currently implemented:
 396
 397 dd. string             set deadline
 398 ss. string             set scheduling
 399 tt. string             set time tamp, here.
 400 ti. string             set inactive time
 401
 402 tg. tag1 tag2 tag3     set all these tags, change case where necessary
 403 td. kwd                set this todo keyword, change case where necessary
 404
 405 FIXME: Hmmm, not sure if we can make his work against the
 406 auto-correction feature.  Needs a bit more thinking.  So this function
 407 is currently a noop.")
 408
 409 (provide 'org-mobile)
 410
 411 ;; arch-tag: ace0e26c-58f2-4309-8a61-05ec1535f658
 412
 413 ;;; org-mobile.el ends here
 414