From 0157dddece4c72f40dae7bbdd4de1d04aad137cc Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Tue, 15 Sep 2009 19:06:44 +0100 Subject: [PATCH] Add new file org-mobile.el for communication with OrgMobile This commit also installs target and dependencies in the Makefile --- Makefile | 2 + lisp/org-mobile.el | 406 +++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 408 insertions(+) create mode 100644 lisp/org-mobile.el diff --git a/Makefile b/Makefile index f1b541b03..5db32c7d4 100644 --- a/Makefile +++ b/Makefile @@ -91,6 +91,7 @@ LISPF = org.el \ org-macs.el \ org-mew.el \ org-mhe.el \ + org-mobile.el \ org-mouse.el \ org-publish.el \ org-plot.el \ @@ -362,6 +363,7 @@ lisp/org-mac-message.elc: lisp/org.el lisp/org-macs.elc: lisp/org-mew.elc: lisp/org.el lisp/org-mhe.elc: lisp/org.el +lisp/org-mobile.elc: lisp/org.el lisp/org-mouse.elc: lisp/org.el lisp/org-plot.elc: lisp/org.el lisp/org-exp.el lisp/org-table.el lisp/org-publish.elc: diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el new file mode 100644 index 000000000..a625b55bc --- /dev/null +++ b/lisp/org-mobile.el @@ -0,0 +1,406 @@ +;;; org-mobile.el --- Code for asymmetric sync with a mobile device +;; Copyright (C) 2009 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.30trans +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs 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 of the License, or +;; (at your option) any later version. +;; +;; GNU Emacs 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. If not, see . +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; 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. + +(require 'org) +(require 'org-agenda) + +(defgroup org-mobile nil + "Options concerning support for a viewer on a mobile device." + :tag "Org Mobile" + :group 'org) + +(defcustom org-mobile-directory "" + "The WebDAV directory where the interaction with the mobile takes place." + :group 'org-mobile + :type 'directory) + +(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 +`org-mobile-capture-file' will be emptied it's contents have +been appended to the file given here." + :group 'org-mobile + :type 'file) + +(defcustom org-mobile-capture-file "mobile-capture.org" + "The capture file where the mobile stores captured notes and flags. +Relative to `org-mobile-directory'." + :group 'org-mobile + :type 'file) + +(defcustom org-mobile-index-file "index.org" + "The index file with inks to all Org files that should be loaded by MobileOrg. +Relative to `org-mobile-directory'." + :group 'org-mobile + :type 'file) + +(defcustom org-mobile-force-id-on-agenda-items t + "Non-nil means make all agenda items carry and ID." + :group 'org-mobile + :type 'boolean) + +(defcustom org-mobile-action-alist + '(("d" . (org-todo 'done)) + ("a" . (org-archive-subtree-default)) + ("d-a" . (progn (org-todo 'done) (org-archive-subtree-default)))) + "Alist with flags and actions for mobile sync. +When flagging an entry, MobileOrg will create entries that look like + + * F(action) [[id:entry-id][entry title]] + +This alist defines that the action in the parentheses of F() should mean, +i.e. what action should be taken. The car of each elements of the alist +is an actions string. The cdr is an Emacs Lisp form that will be evaluated +with the cursor on the headline of that entry." + :group 'org-mobile + :type '(repeat + (cons (string :tag "Action flag") + (sexp :tag "Action form")))) + +(defvar org-mobile-pre-push-hook nil + "Hook run before running `org-mobile-push'. +This could be used to clean up `org-mobile-directory', for example to +remove files that used to be included in the agenda but no longer are. +The presence of such files would not really be a problem, but after time +they may accumulate.") + +(defvar org-mobile-post-push-hook nil + "Hook run after running `org-mobile-push'. +If Emacs does not have direct write access to the WebDAV directory used +by the mobile device, this hook could be used to copy all files from the +local `org-mobile-directory' to the WebDAV directory, for example using +`rsync' or `scp'.") + +(defvar org-mobile-pre-pull-hook nil + "Hook run before executing `org-mobile-pull'. +If Emacs does not have direct write access to the WebDAV directory used +by the mobile device, this hook could be used to copy all files from the +WebDAV location to the local staging directory `org-mobile-directory'.") + +(defvar org-mobile-post-pull-hook nil + "Hook run after running `org-mobile-pull'. +If Emacs does not have direct write access to the WebDAV directory used +by the mobile device, this hook could be used to copy all files from the +local `org-mobile-directory' to the WebDAV directory, for example using +`rsync' or `scp'. The only file that will be changed after a pull is +`org-mobile-capture-file'.") + +(defvar org-mobile-last-flagged-files nil + "List of files containing entreis flagged in the latest pull.") + +;;;###autoload +(defun org-mobile-push () + "Push the current state of Org affairs to the WebDAV directory. +This will create the index file, copy all agenda files there, and also +create all custom agenda views, for upload to the mobile phone." + (interactive) + (org-mobile-check-setup) + (run-hooks 'org-mobile-pre-push-hook) + (org-mobile-create-sumo-agenda) + (org-save-all-org-buffers) ; to save any IDs created by this process + (org-mobile-copy-agenda-files) + (org-mobile-create-index-file) + (org-mobile-write-checksums) + (run-hooks 'org-mobile-post-push-hook) + (message "Files for mobile viewer staged")) + +;;;###autoload +(defun org-mobile-pull () + "Pull the contents of `org-mobile-capture-file' and integrate them. +Apply all flagged actions, flag entries to be flagged and then call an +agenda view showing the flagged items." + (interactive) + (org-mobile-check-setup) + (run-hooks 'org-mobile-pre-pull-hook) + (let ((insertion-marker (org-mobile-move-capture))) + (if (not (markerp insertion-marker)) + (message "No new items") + (org-with-point-at insertion-marker + (org-mobile-apply-flags (point) (point-max))) + (move-marker insertion-marker nil) + (run-hooks 'org-mobile-post-pull-hook) + (when org-mobile-last-flagged-files + ;; Make an agenda view of flagged entries, but only in the files + ;; where stuff has been added. + (put 'org-agenda-files 'org-restrict org-mobile-last-flagged-files) + (let ((org-agenda-keep-restriced-file-list t)) + (org-agenda nil "?")))))) + +(defun org-mobile-check-setup () + "Check if org-mobile-directory has been set up." + (when (or (not org-mobile-directory) + (not (stringp org-mobile-directory)) + (not (string-match "\\S-" org-mobile-directory)) + (not (file-exists-p org-mobile-directory)) + (not (file-directory-p org-mobile-directory))) + (error + "Variable `org-mobile-directory' must point to an existing directory")) + (when (or (not org-mobile-inbox-for-pull) + (not (stringp org-mobile-inbox-for-pull)) + (not (string-match "\\S-" org-mobile-inbox-for-pull)) + (not (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"))) + +(defun org-mobile-create-index-file () + "Write the index file in the WebDAV directory." + (interactive) + (with-temp-file (expand-file-name org-mobile-index-file org-mobile-directory) + (insert "* [[file:agendas.org][Agenda Views]]\n") + (let ((files (org-agenda-files t)) file) + (while (setq file (pop files)) + (insert (format "* [[file:%s][%s]]\n" + (file-name-nondirectory file) + (capitalize + (file-name-sans-extension + (file-name-nondirectory file)))))) + (insert (format "* [[file:%s][Captured before last sync]]\n" + (file-name-sans-extension org-mobile-capture-file)))))) + +(defun org-mobile-copy-agenda-files () + "Copy all agenda files to the stage or WebDAV directory." + (let ((files (org-agenda-files t)) file) + (while (setq file (pop files)) + (if (file-exists-p file) + (copy-file file (expand-file-name (file-name-nondirectory file) + org-mobile-directory) + 'ok-if-exists))))) + +(defun org-mobile-write-checksums () + "Create checksums for all files in `org-mobile-directory'. +The table of checksums is written to the file mobile-checksums." + (let ((cmd (cond ((executable-find "shasum")) + ((executable-find "sha1sum")) + ((executable-find "md5sum")) + ((executable-find "md5"))))) + (if (not cmd) + (message "Checksums could not be generated: no executable") + (with-temp-buffer + (cd org-mobile-directory) + (if (equal 0 (shell-command (concat cmd " *.org > checksums.dat"))) + (message "Checksums written") + (message "Checksums could not be generated")))))) + +(defun org-mobile-sumo-agenda-command () + "Return an agenda custom command that comprises all custom commands." + (let ((custom-list + ;; normalize different versions + (delq nil + (mapcar + (lambda (x) + (cond ((stringp (cdr x)) nil) + ((stringp (nth 1 x)) x) + ((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)) + (cond + ((stringp (cdr e)) + ;; this is a description entry - skip it + ) + ((eq (nth 2 e) 'search) + ;; Search view is interactive, skip + ) + ((memq (nth 2 e) '(todo-tree tags-tree occur-tree)) + ;; These are trees, not really agenda commands + ) + ((memq (nth 2 e) '(agenda todo tags)) + ;; a normal command + (setq key (car e) desc (nth 1 e) type (nth 2 e) match (nth 3 e) + settings (nth 4 e)) + (setq settings + (cons (list 'org-agenda-title-append + (concat "KEYS=" key " TITLE: " + (if (and (stringp desc) (> (length desc) 0)) + desc (symbol-name type)) + " " match)) + settings)) + (push (list type match settings) new)) + ((symbolp (nth 2 e)) + ;; A user-defined function, not sure how to handle that yet + ) + (t + ;; a block agenda + (setq gkey (car e) gdesc (nth 1 e) gsettings (nth 3 e) cmds (nth 2 e)) + (setq cnt 0) + (while (setq e (pop cmds)) + (setq type (car e) match (nth 1 e) settings (nth 2 e)) + (setq settings (append gsettings settings)) + (setq settings + (cons (list 'org-agenda-title-append + (concat "KEYS=" gkey "#" (number-to-string + (setq cnt (1+ cnt))) + " TITLE: " gdesc " " match)) + settings)) + (push (list type match settings) new))))) + (list "X" "SUMO" (reverse new) nil))) + +;;;###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)) + (org-agenda-custom-commands + (list (append (org-mobile-sumo-agenda-command) + (list (list file)))))) + (unless (file-writable-p file) + (error "Cannot write to file %s" file)) + (org-batch-store-agenda-views))) + +(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 beed 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) + (save-excursion + (set-buffer capture-buffer) + (setq content (buffer-string)) + (setq not-empty (string-match "\\S-" content)) + (when not-empty + (set-buffer inbox-buffer) + (widen) + (goto-char (point-max)) + (or (bolp) (newline)) + (move-marker insertion-point + (prog1 (point) (insert content))) + (save-buffer) + (set-buffer capture-buffer) + (erase-buffer) + (save-buffer))) + (kill-buffer capture-buffer) + (if not-empty insertion-point))) + +(defun org-mobile-apply-flags (&optional beg end) + "Apply all flags in the current buffer. +If BEG and END are given, only do this in that region." + (interactive) + (setq org-mobile-last-flagged-files nil) + (setq beg (or beg (point-min)) end (or end (point-max))) + (goto-char beg) + (let ((marker (make-marker)) + (end (move-marker (make-marker) end)) + action id id-pos cmd text) + (while (re-search-forward + "^\\*+[ \t]+F(\\([^()\n]*\\))[ \t]+\\[\\[id:\\([^]\n ]+\\)" end t) + (goto-char (- (match-beginning 1) 2)) + (catch 'next + (setq action (match-string 1) + id (match-string 2) + cmd (if (equal action "") + '(progn + (org-toggle-tag "FLAGGED" 'on) + (and text (org-entry-put nil "THEFLAGGINGNOTE" text))) + (cdr (assoc action org-mobile-action-alist))) + text (org-trim (buffer-substring (1+ (point-at-eol)) + (save-excursion + (org-end-of-subtree t)))) + id-pos (org-id-find id 'marker)) + (if (> (length text) 0) + ;; Make TEXT into a single line, to fit into a property + (setq text (mapconcat 'identity + (org-split-string text "\n") + "\\n")) + (setq text nil)) + (unless id-pos + (insert "BAD ID REFERENCE ") + (throw 'next t)) + (unless cmd + (insert "BAD FLAG ") + (throw 'next t)) + (move-marker marker (point)) + (save-excursion + (condition-case nil + (org-with-point-at id-pos + (progn + (eval cmd) + (if (member "FLAGGED" (org-get-tags)) + (add-to-list 'org-mobile-last-flagged-files + (buffer-file-name (current-buffer)))))) + (error + (progn + (switch-to-buffer (marker-buffer marker)) + (goto-char marker) + (insert "EXECUTION FAILED ") + (throw 'next t))))) + ;; If we get here, the action has been applied successfully + ;; So remove the entry + (org-back-to-heading t) + (delete-region (point) (org-end-of-subtree t t)))) + (move-marker marker nil) + (move-marker end nil))) + +(defun org-mobile-smart-read () + "Parse the entry at point for shortcuts and expand them. +These shortcuts are meant for fast and easy typing on the limited +keyboards of a mobile device. Below we show a list of the shortcuts +currently implemented. + +The entry is expected to contain an inactive time stamp indicating when +the entry was created. When setting dates and +times (for example for deadlines), the time strings are interpreted +relative to that creation date. +Abbreviations are expected to take up entire lines, jst because it is so +easy to type RET on a mobile device. Abbreviations start with one or two +letters, followed immediately by a dot and then additional information. +Generally the entire shortcut line is removed after action have been taken. +Time stamps will be constructed using `org-read-date'. So for example a +line \"dd. 2tue\" will set a deadline on the second Tuesday after the +creation date. + +Here are the shortcuts currently implemented: + +dd. string set deadline +ss. string set scheduling +tt. string set time tamp, here. +ti. string set inactive time + +tg. tag1 tag2 tag3 set all these tags, change case where necessary +td. kwd set this todo keyword, change case where necessary + +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.") + +(provide 'org-mobile) + +;; arch-tag: ace0e26c-58f2-4309-8a61-05ec1535f658 + +;;; org-mobile.el ends here +