]> code.delx.au - gnu-emacs/blobdiff - lisp/org/org-mobile.el
Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs
[gnu-emacs] / lisp / org / org-mobile.el
index ffdd66513bef5f0577d9145657759c531c1d7d13..f535390790f0365954871037dfe9f914f9bf7cdb 100644 (file)
@@ -1,5 +1,5 @@
 ;;; org-mobile.el --- Code for asymmetric sync with a mobile device
-;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
 ;;
 ;; Author: Carsten Dominik <carsten at orgmode dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
@@ -76,12 +76,19 @@ org-agenda-text-search-extra-files
   :group 'org-mobile
   :type 'directory)
 
+(defcustom org-mobile-allpriorities "A B C"
+  "Default set of priority cookies for the index file."
+  :version "24.4"
+  :package-version '(Org . "8.0")
+  :type 'string
+  :group 'org-mobile)
+
 (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
+Turning on encryption requires setting 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
@@ -276,7 +283,7 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
                      (list f))
                     (t nil)))
                  org-mobile-files)))
-        (files (delete
+        (files (delq
                 nil
                 (mapcar (lambda (f)
                           (unless (and (not (string= org-mobile-files-exclude-regexp ""))
@@ -300,44 +307,46 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
        (push (cons file link-name) rtn)))
     (nreverse rtn)))
 
-(defvar org-agenda-filter)
-
 ;;;###autoload
 (defun org-mobile-push ()
-  "Push the current state of Org affairs to the WebDAV directory.
+  "Push the current state of Org affairs to the target 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)
   (let ((a-buffer (get-buffer org-agenda-buffer-name)))
-    (let ((org-agenda-buffer-name "*SUMO*")
+    (let ((org-agenda-curbuf-name org-agenda-buffer-name)
+         (org-agenda-buffer-name "*SUMO*")
          (org-agenda-tag-filter org-agenda-tag-filter)
          (org-agenda-redo-command org-agenda-redo-command))
       (save-excursion
-       (save-window-excursion
-         (run-hooks 'org-mobile-pre-push-hook)
-         (org-mobile-check-setup)
-         (org-mobile-prepare-file-lists)
-         (message "Creating agendas...")
-         (let ((inhibit-redisplay t)
-               (org-agenda-files (mapcar 'car org-mobile-files-alist)))
-           (org-mobile-create-sumo-agenda))
-         (message "Creating agendas...done")
-         (org-save-all-org-buffers) ; to save any IDs created by this process
-         (message "Copying files...")
-         (org-mobile-copy-agenda-files)
-         (message "Writing index file...")
-         (org-mobile-create-index-file)
-         (message "Writing checksums...")
-         (org-mobile-write-checksums)
-         (run-hooks 'org-mobile-post-push-hook))))
+       (save-restriction
+         (save-window-excursion
+           (run-hooks 'org-mobile-pre-push-hook)
+           (org-mobile-check-setup)
+           (org-mobile-prepare-file-lists)
+           (message "Creating agendas...")
+           (let ((inhibit-redisplay t)
+                 (org-agenda-files (mapcar 'car org-mobile-files-alist)))
+             (org-mobile-create-sumo-agenda))
+           (message "Creating agendas...done")
+           (org-save-all-org-buffers) ; to save any IDs created by this process
+           (message "Copying files...")
+           (org-mobile-copy-agenda-files)
+           (message "Writing index file...")
+           (org-mobile-create-index-file)
+           (message "Writing checksums...")
+           (org-mobile-write-checksums)
+           (run-hooks 'org-mobile-post-push-hook))))
+      (setq org-agenda-buffer-name org-agenda-curbuf-name
+           org-agenda-this-buffer-name org-agenda-curbuf-name))
     (redraw-display)
-    (when (and a-buffer (buffer-live-p a-buffer))
+    (when (buffer-live-p a-buffer)
       (if (not (get-buffer-window a-buffer))
-         (kill-buffer a-buffer)
-       (let ((cw (selected-window)))
-         (select-window (get-buffer-window a-buffer))
-         (org-agenda-redo)
-         (select-window cw)))))
+         (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
@@ -417,7 +426,8 @@ agenda view showing the flagged items."
        (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)
-
+    (when (stringp (car def-todo))
+      (setq def-todo (list (cons 'sequence def-todo))))
     (org-agenda-prepare-buffers (mapcar 'car files-alist))
     (setq done-kwds (org-uniquify org-done-keywords-for-agenda))
     (setq todo-kwds (org-delete-all
@@ -450,6 +460,7 @@ agenda view showing the flagged items."
                              ((stringp x) x)
                              ((eq (car x) :startgroup) "{")
                              ((eq (car x) :endgroup) "}")
+                             ((eq (car x) :grouptags) nil)
                              ((eq (car x) :newline) nil)
                              ((listp x) (car x))))
                      def-tags))
@@ -459,7 +470,7 @@ agenda view showing the flagged items."
       (setq tags (append def-tags tags nil))
       (insert "#+TAGS: " (mapconcat 'identity tags " ") "\n")
       (insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n")
-      (insert "#+ALLPRIORITIES: A B C" "\n")
+      (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n")
       (when (file-exists-p (expand-file-name
                            org-mobile-directory "agendas.org"))
        (insert "* [[file:agendas.org][Agenda Views]]\n"))
@@ -536,7 +547,7 @@ The table of checksums is written to the file mobile-checksums."
                        (t (cons (car x) (cons "" (cdr x))))))
                org-agenda-custom-commands)))
        (default-list '(("a" "Agenda" agenda) ("t" "All TODO" alltodo)))
-       thelist new e key desc type match settings cmds gkey gdesc gsettings cnt)
+       thelist atitle new e key desc type match settings cmds gkey gdesc gsettings cnt)
     (cond
      ((eq org-mobile-agendas 'custom)
       (setq thelist custom-list))
@@ -588,12 +599,13 @@ The table of checksums is written to the file mobile-checksums."
        (setq cnt 0)
        (while (setq e (pop cmds))
          (setq type (car e) match (nth 1 e) settings (nth 2 e))
+         (setq atitle (if (string= "" gdesc) match gdesc))
          (setq settings (append gsettings settings))
          (setq settings
                (cons (list 'org-agenda-title-append
                            (concat "<after>KEYS=" gkey "#" (number-to-string
                                                             (setq cnt (1+ cnt)))
-                                   " TITLE: " gdesc " " match "</after>"))
+                                   " TITLE: " atitle "</after>"))
                      settings))
          (push (list type match settings) new)))))
     (and new (list "X" "SUMO" (reverse new)
@@ -615,12 +627,10 @@ The table of checksums is written to the file mobile-checksums."
          (delete-region (point) (point-at-eol)))
         ((get-text-property (point) 'org-agenda-structural-header)
          (setq in-date nil)
-         (setq app (get-text-property (point)
-                                      'org-agenda-title-append))
-         (setq short (get-text-property (point)
-                                        'short-heading))
+         (setq app (get-text-property (point) 'org-agenda-title-append))
+         (setq short (get-text-property (point) 'short-heading))
          (when (and short (looking-at ".+"))
-           (replace-match short)
+           (replace-match short nil t)
            (beginning-of-line 1))
          (when app
            (end-of-line 1)
@@ -983,7 +993,7 @@ is currently a noop.")
              (goto-char (point-max))
              (newline)
              (goto-char (point-max))
-             (move-marker (make-marker) (point)))))
+             (point-marker))))
       (let ((file (match-string 1 link))
            (path (match-string 2 link)))
        (setq file (org-link-unescape file))
@@ -1058,10 +1068,13 @@ be returned that indicates what went wrong."
         (t (error "Heading changed in MobileOrg and on the computer")))))
 
      ((eq what 'addheading)
-      (if (org-on-heading-p) ; if false we are in top-level of file
+      (if (org-at-heading-p) ; if false we are in top-level of file
          (progn
+           ;; Workaround a `org-insert-heading-respect-content' bug
+           ;; which prevents correct insertion when point is invisible
+           (org-show-subtree)
            (end-of-line 1)
-           (org-insert-heading-respect-content)
+           (org-insert-heading-respect-content t)
            (org-demote))
        (beginning-of-line)
        (insert "* "))
@@ -1070,7 +1083,7 @@ be returned that indicates what went wrong."
      ((eq what 'refile)
       (org-copy-subtree)
       (org-with-point-at (org-mobile-locate-entry new)
-       (if (org-on-heading-p) ; if false we are in top-level of file
+       (if (org-at-heading-p) ; if false we are in top-level of file
            (progn
              (setq level (org-get-valid-level (funcall outline-level) 1))
              (org-end-of-subtree t t)