| commit | author | age | ||
| 76bbd0 | 1 | ;;; org-mobile.el --- Code for Asymmetric Sync With a Mobile Device -*- lexical-binding: t; -*- |
| C | 2 | ;; Copyright (C) 2009-2018 Free Software Foundation, Inc. |
| 3 | ;; | |
| 4 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
| 5 | ;; Keywords: outlines, hypermedia, calendar, wp | |
| 6 | ;; Homepage: https://orgmode.org | |
| 7 | ;; | |
| 8 | ;; This file is part of GNU Emacs. | |
| 9 | ;; | |
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
| 11 | ;; it under the terms of the GNU General Public License as published by | |
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | |
| 13 | ;; (at your option) any later version. | |
| 14 | ;; | |
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 18 | ;; GNU General Public License for more details. | |
| 19 | ;; | |
| 20 | ;; You should have received a copy of the GNU General Public License | |
| 21 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | |
| 22 | ;; | |
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
| 24 | ;; | |
| 25 | ;;; Commentary: | |
| 26 | ;; | |
| 27 | ;; This file contains the code to interact with Richard Moreland's | |
| 28 | ;; iPhone application MobileOrg, as well as with the Android version | |
| 29 | ;; by Matthew Jones. This code is documented in Appendix B of the Org | |
| 30 | ;; manual. The code is not specific for the iPhone and Android - any | |
| 31 | ;; external viewer/flagging/editing application that uses the same | |
| 32 | ;; conventions could be used. | |
| 33 | ||
| 34 | (require 'org) | |
| 35 | (require 'org-agenda) | |
| 36 | (require 'cl-lib) | |
| 37 | ||
| 38 | (defvar org-agenda-keep-restricted-file-list) | |
| 39 | ||
| 40 | ;;; Code: | |
| 41 | ||
| 42 | (defgroup org-mobile nil | |
| 43 | "Options concerning support for a viewer/editor on a mobile device." | |
| 44 | :tag "Org Mobile" | |
| 45 | :group 'org) | |
| 46 | ||
| 47 | (defcustom org-mobile-files '(org-agenda-files) | |
| 48 | "Files to be staged for MobileOrg. | |
| 49 | This is basically a list of files and directories. Files will be staged | |
| 50 | directly. Directories will be search for files with the extension `.org'. | |
| 51 | In addition to this, the list may also contain the following symbols: | |
| 52 | ||
| 53 | org-agenda-files | |
| 54 | This means include the complete, unrestricted list of files given in | |
| 55 | the variable `org-agenda-files'. | |
| 56 | org-agenda-text-search-extra-files | |
| 57 | Include the files given in the variable | |
| 58 | `org-agenda-text-search-extra-files'" | |
| 59 | :group 'org-mobile | |
| 60 | :type '(list :greedy t | |
| 61 | (option (const :tag "org-agenda-files" org-agenda-files)) | |
| 62 | (option (const :tag "org-agenda-text-search-extra-files" | |
| 63 | org-agenda-text-search-extra-files)) | |
| 64 | (repeat :inline t :tag "Additional files" | |
| 65 | (file)))) | |
| 66 | ||
| 67 | (defcustom org-mobile-files-exclude-regexp "" | |
| 68 | "A regexp to exclude files from `org-mobile-files'." | |
| 69 | :group 'org-mobile | |
| 70 | :version "24.1" | |
| 71 | :type 'regexp) | |
| 72 | ||
| 73 | (defcustom org-mobile-directory "" | |
| 74 | "The WebDAV directory where the interaction with the mobile takes place." | |
| 75 | :group 'org-mobile | |
| 76 | :type 'directory) | |
| 77 | ||
| 78 | (defcustom org-mobile-allpriorities "A B C" | |
| 79 | "Default set of priority cookies for the index file." | |
| 80 | :version "24.4" | |
| 81 | :package-version '(Org . "8.0") | |
| 82 | :type 'string | |
| 83 | :group 'org-mobile) | |
| 84 | ||
| 85 | (defcustom org-mobile-use-encryption nil | |
| 86 | "Non-nil means keep only encrypted files on the WebDAV server. | |
| 87 | Encryption uses AES-256, with a password given in | |
| 88 | `org-mobile-encryption-password'. | |
| 89 | When nil, plain files are kept on the server. | |
| 90 | Turning on encryption requires setting the same password in the MobileOrg | |
| 91 | application. Before turning this on, check of MobileOrg does already | |
| 92 | support it - at the time of this writing it did not yet." | |
| 93 | :group 'org-mobile | |
| 94 | :version "24.1" | |
| 95 | :type 'boolean) | |
| 96 | ||
| 97 | (defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt" | |
| 98 | "File that is being used as a temporary file for encryption. | |
| 99 | This must be local file on your local machine (not on the WebDAV server). | |
| 100 | You might want to put this file into a directory where only you have access." | |
| 101 | :group 'org-mobile | |
| 102 | :version "24.1" | |
| 103 | :type 'directory) | |
| 104 | ||
| 105 | (defcustom org-mobile-encryption-password "" | |
| 106 | "Password for encrypting files uploaded to the server. | |
| 107 | This is a single password which is used for AES-256 encryption. The same | |
| 108 | password must also be set in the MobileOrg application. All Org files, | |
| 109 | including mobileorg.org will be encrypted using this password. | |
| 110 | ||
| 111 | SECURITY CONSIDERATIONS: | |
| 112 | ||
| 113 | Note that, when Org runs the encryption commands, the password could | |
| 114 | be visible briefly on your system with the `ps' command. So this method is | |
| 115 | only intended to keep the files secure on the server, not on your own machine. | |
| 116 | ||
| 117 | Also, if you set this variable in an init file (.emacs or .emacs.d/init.el | |
| 118 | or custom.el...) and if that file is stored in a way so that other can read | |
| 119 | it, this also limits the security of this approach. You can also leave | |
| 120 | this variable empty - Org will then ask for the password once per Emacs | |
| 121 | session." | |
| 122 | :group 'org-mobile | |
| 123 | :version "24.1" | |
| 124 | :type '(string :tag "Password")) | |
| 125 | ||
| 126 | (defvar org-mobile-encryption-password-session nil) | |
| 127 | ||
| 128 | (defun org-mobile-encryption-password () | |
| 129 | (or (org-string-nw-p org-mobile-encryption-password) | |
| 130 | (org-string-nw-p org-mobile-encryption-password-session) | |
| 131 | (setq org-mobile-encryption-password-session | |
| 132 | (read-passwd "Password for MobileOrg: " t)))) | |
| 133 | ||
| 134 | (defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org" | |
| 135 | "The file where captured notes and flags will be appended to. | |
| 136 | During the execution of `org-mobile-pull', the file | |
| 137 | `org-mobile-capture-file' will be emptied it's contents have | |
| 138 | been appended to the file given here. This file should be in | |
| 139 | `org-directory', and not in the staging area or on the web server." | |
| 140 | :group 'org-mobile | |
| 141 | :type 'file) | |
| 142 | ||
| 143 | (defconst org-mobile-capture-file "mobileorg.org" | |
| 144 | "The capture file where the mobile stores captured notes and flags. | |
| 145 | This should not be changed, because MobileOrg assumes this name.") | |
| 146 | ||
| 147 | (defcustom org-mobile-index-file "index.org" | |
| 148 | "The index file with links to all Org files that should be loaded by MobileOrg. | |
| 149 | Relative to `org-mobile-directory'. The Address field in the MobileOrg setup | |
| 150 | should point to this file." | |
| 151 | :group 'org-mobile | |
| 152 | :type 'file) | |
| 153 | ||
| 154 | (defcustom org-mobile-agendas 'all | |
| 155 | "The agendas that should be pushed to MobileOrg. | |
| 156 | Allowed values: | |
| 157 | ||
| 158 | default the weekly agenda and the global TODO list | |
| 159 | custom all custom agendas defined by the user | |
| 160 | all the custom agendas and the default ones | |
| 161 | list a list of selection key(s) as string." | |
| 162 | :group 'org-mobile | |
| 163 | :version "24.1" | |
| 164 | :type '(choice | |
| 165 | (const :tag "Default Agendas" default) | |
| 166 | (const :tag "Custom Agendas" custom) | |
| 167 | (const :tag "Default and Custom Agendas" all) | |
| 168 | (repeat :tag "Selected" | |
| 169 | (string :tag "Selection Keys")))) | |
| 170 | ||
| 171 | (defcustom org-mobile-force-id-on-agenda-items t | |
| 172 | "Non-nil means make all agenda items carry an ID." | |
| 173 | :group 'org-mobile | |
| 174 | :type 'boolean) | |
| 175 | ||
| 176 | (defcustom org-mobile-force-mobile-change nil | |
| 177 | "Non-nil means force the change made on the mobile device. | |
| 178 | So even if there have been changes to the computer version of the entry, | |
| 179 | force the new value set on the mobile. | |
| 180 | When nil, mark the entry from the mobile with an error message. | |
| 181 | Instead of nil or t, this variable can also be a list of symbols, indicating | |
| 182 | the editing types for which the mobile version should always dominate." | |
| 183 | :group 'org-mobile | |
| 184 | :type '(choice | |
| 185 | (const :tag "Always" t) | |
| 186 | (const :tag "Never" nil) | |
| 187 | (set :greedy t :tag "Specify" | |
| 188 | (const todo) | |
| 189 | (const tags) | |
| 190 | (const priority) | |
| 191 | (const heading) | |
| 192 | (const body)))) | |
| 193 | ||
| 194 | (defcustom org-mobile-checksum-binary (or (executable-find "shasum") | |
| 195 | (executable-find "sha1sum") | |
| 196 | (executable-find "md5sum") | |
| 197 | (executable-find "md5")) | |
| 198 | "Executable used for computing checksums of agenda files." | |
| 199 | :group 'org-mobile | |
| 200 | :type 'string) | |
| 201 | ||
| 202 | (defvar org-mobile-pre-push-hook nil | |
| 203 | "Hook run before running `org-mobile-push'. | |
| 204 | This could be used to clean up `org-mobile-directory', for example to | |
| 205 | remove files that used to be included in the agenda but no longer are. | |
| 206 | The presence of such files would not really be a problem, but after time | |
| 207 | they may accumulate.") | |
| 208 | ||
| 209 | (defvar org-mobile-post-push-hook nil | |
| 210 | "Hook run after running `org-mobile-push'. | |
| 211 | If Emacs does not have direct write access to the WebDAV directory used | |
| 212 | by the mobile device, this hook should be used to copy all files from the | |
| 213 | local staging directory `org-mobile-directory' to the WebDAV directory, | |
| 214 | for example using `rsync' or `scp'.") | |
| 215 | ||
| 216 | (defvar org-mobile-pre-pull-hook nil | |
| 217 | "Hook run before executing `org-mobile-pull'. | |
| 218 | If Emacs does not have direct write access to the WebDAV directory used | |
| 219 | by the mobile device, this hook should be used to copy the capture file | |
| 220 | `mobileorg.org' from the WebDAV location to the local staging | |
| 221 | directory `org-mobile-directory'.") | |
| 222 | ||
| 223 | (defvar org-mobile-post-pull-hook nil | |
| 224 | "Hook run after running `org-mobile-pull', only if new items were found. | |
| 225 | If Emacs does not have direct write access to the WebDAV directory used | |
| 226 | by the mobile device, this hook should be used to copy the emptied | |
| 227 | capture file `mobileorg.org' back to the WebDAV directory, for example | |
| 228 | using `rsync' or `scp'.") | |
| 229 | ||
| 230 | (defconst org-mobile-action-alist '(("edit" . org-mobile-edit)) | |
| 231 | "Alist with flags and actions for mobile sync. | |
| 232 | When flagging an entry, MobileOrg will create entries that look like | |
| 233 | ||
| 234 | * F(action:data) [[id:entry-id][entry title]] | |
| 235 | ||
| 236 | This alist defines that the ACTION in the parentheses of F() | |
| 237 | should mean, i.e. what action should be taken. The :data part in | |
| 238 | the parenthesis is optional. If present, the string after the | |
| 239 | colon will be passed to the action function as the first argument | |
| 240 | variable. | |
| 241 | ||
| 242 | The car of each elements of the alist is an actions string. The | |
| 243 | cdr is a function that is called with the cursor on the headline | |
| 244 | of that entry. It should accept three arguments, the :data part, | |
| 245 | the old and new values for the entry.") | |
| 246 | ||
| 247 | (defvar org-mobile-last-flagged-files nil | |
| 248 | "List of files containing entries flagged in the latest pull.") | |
| 249 | ||
| 250 | (defvar org-mobile-files-alist nil) | |
| 251 | (defvar org-mobile-checksum-files nil) | |
| 252 | ||
| 253 | (defun org-mobile-prepare-file-lists () | |
| 254 | (setq org-mobile-files-alist (org-mobile-files-alist)) | |
| 255 | (setq org-mobile-checksum-files nil)) | |
| 256 | ||
| 257 | (defun org-mobile-files-alist () | |
| 258 | "Expand the list in `org-mobile-files' to a list of existing files. | |
| 259 | Also exclude files matching `org-mobile-files-exclude-regexp'." | |
| 260 | (let* ((include-archives | |
| 261 | (and (member 'org-agenda-text-search-extra-files org-mobile-files) | |
| 262 | (member 'agenda-archives org-agenda-text-search-extra-files) | |
| 263 | t)) | |
| 264 | (files | |
| 265 | (apply 'append | |
| 266 | (mapcar | |
| 267 | (lambda (f) | |
| 268 | (cond | |
| 269 | ((eq f 'org-agenda-files) | |
| 270 | (org-agenda-files t include-archives)) | |
| 271 | ((eq f 'org-agenda-text-search-extra-files) | |
| 272 | (delq 'agenda-archives | |
| 273 | (copy-sequence | |
| 274 | org-agenda-text-search-extra-files))) | |
| 275 | ((and (stringp f) (file-directory-p f)) | |
| 276 | (directory-files f 'full "\\.org\\'")) | |
| 277 | ((and (stringp f) (file-exists-p f)) | |
| 278 | (list f)) | |
| 279 | (t nil))) | |
| 280 | org-mobile-files))) | |
| 281 | (files (delq | |
| 282 | nil | |
| 283 | (mapcar (lambda (f) | |
| 284 | (unless (and (not (string= org-mobile-files-exclude-regexp "")) | |
| 285 | (string-match org-mobile-files-exclude-regexp f)) | |
| 286 | (identity f))) | |
| 287 | files))) | |
| 288 | (orgdir-uname (file-name-as-directory (file-truename org-directory))) | |
| 289 | (orgdir-re (concat "\\`" (regexp-quote orgdir-uname))) | |
| 290 | uname seen rtn file link-name) | |
| 291 | ;; Make the files unique, and determine the name under which they will | |
| 292 | ;; be listed. | |
| 293 | (while (setq file (pop files)) | |
| 294 | (if (not (file-name-absolute-p file)) | |
| 295 | (setq file (expand-file-name file org-directory))) | |
| 296 | (setq uname (file-truename file)) | |
| 297 | (unless (member uname seen) | |
| 298 | (push uname seen) | |
| 299 | (if (string-match orgdir-re uname) | |
| 300 | (setq link-name (substring uname (match-end 0))) | |
| 301 | (setq link-name (file-name-nondirectory uname))) | |
| 302 | (push (cons file link-name) rtn))) | |
| 303 | (nreverse rtn))) | |
| 304 | ||
| 305 | ;;;###autoload | |
| 306 | (defun org-mobile-push () | |
| 307 | "Push the current state of Org affairs to the target directory. | |
| 308 | This will create the index file, copy all agenda files there, and also | |
| 309 | create all custom agenda views, for upload to the mobile phone." | |
| 310 | (interactive) | |
| 311 | (let ((org-agenda-buffer-name "*SUMO*") | |
| 312 | (org-agenda-tag-filter org-agenda-tag-filter) | |
| 313 | (org-agenda-redo-command org-agenda-redo-command)) | |
| 314 | (save-excursion | |
| 315 | (save-restriction | |
| 316 | (save-window-excursion | |
| 317 | (run-hooks 'org-mobile-pre-push-hook) | |
| 318 | (org-mobile-check-setup) | |
| 319 | (org-mobile-prepare-file-lists) | |
| 320 | (message "Creating agendas...") | |
| 321 | (let ((inhibit-redisplay t) | |
| 322 | (org-agenda-files (mapcar 'car org-mobile-files-alist))) | |
| 323 | (org-mobile-create-sumo-agenda)) | |
| 324 | (message "Creating agendas...done") | |
| 325 | (org-save-all-org-buffers) ; to save any IDs created by this process | |
| 326 | (message "Copying files...") | |
| 327 | (org-mobile-copy-agenda-files) | |
| 328 | (message "Writing index file...") | |
| 329 | (org-mobile-create-index-file) | |
| 330 | (message "Writing checksums...") | |
| 331 | (org-mobile-write-checksums) | |
| 332 | (run-hooks 'org-mobile-post-push-hook))))) | |
| 333 | (org-agenda-maybe-redo) | |
| 334 | (message "Files for mobile viewer staged")) | |
| 335 | ||
| 336 | (defvar org-mobile-before-process-capture-hook nil | |
| 337 | "Hook that is run after content was moved to `org-mobile-inbox-for-pull'. | |
| 338 | The inbox file is visited by the current buffer, and the buffer is | |
| 339 | narrowed to the newly captured data.") | |
| 340 | ||
| 341 | ;;;###autoload | |
| 342 | (defun org-mobile-pull () | |
| 343 | "Pull the contents of `org-mobile-capture-file' and integrate them. | |
| 344 | Apply all flagged actions, flag entries to be flagged and then call an | |
| 345 | agenda view showing the flagged items." | |
| 346 | (interactive) | |
| 347 | (org-mobile-check-setup) | |
| 348 | (run-hooks 'org-mobile-pre-pull-hook) | |
| 349 | (let ((insertion-marker (org-mobile-move-capture))) | |
| 350 | (if (not (markerp insertion-marker)) | |
| 351 | (message "No new items") | |
| 352 | (org-with-point-at insertion-marker | |
| 353 | (save-restriction | |
| 354 | (narrow-to-region (point) (point-max)) | |
| 355 | (run-hooks 'org-mobile-before-process-capture-hook))) | |
| 356 | (org-with-point-at insertion-marker | |
| 357 | (org-mobile-apply (point) (point-max))) | |
| 358 | (move-marker insertion-marker nil) | |
| 359 | (run-hooks 'org-mobile-post-pull-hook) | |
| 360 | (when org-mobile-last-flagged-files | |
| 361 | ;; Make an agenda view of flagged entries, but only in the files | |
| 362 | ;; where stuff has been added. | |
| 363 | (put 'org-agenda-files 'org-restrict org-mobile-last-flagged-files) | |
| 364 | (let ((org-agenda-keep-restricted-file-list t)) | |
| 365 | (org-agenda nil "?")))))) | |
| 366 | ||
| 367 | (defun org-mobile-check-setup () | |
| 368 | "Check if org-mobile-directory has been set up." | |
| 369 | (org-mobile-cleanup-encryption-tempfile) | |
| 370 | (unless (and org-directory | |
| 371 | (stringp org-directory) | |
| 372 | (string-match "\\S-" org-directory) | |
| 373 | (file-exists-p org-directory) | |
| 374 | (file-directory-p org-directory)) | |
| 375 | (error | |
| 376 | "Please set `org-directory' to the directory where your org files live")) | |
| 377 | (unless (and org-mobile-directory | |
| 378 | (stringp org-mobile-directory) | |
| 379 | (string-match "\\S-" org-mobile-directory) | |
| 380 | (file-exists-p org-mobile-directory) | |
| 381 | (file-directory-p org-mobile-directory)) | |
| 382 | (error | |
| 383 | "Variable `org-mobile-directory' must point to an existing directory")) | |
| 384 | (unless (and org-mobile-inbox-for-pull | |
| 385 | (stringp org-mobile-inbox-for-pull) | |
| 386 | (string-match "\\S-" org-mobile-inbox-for-pull) | |
| 387 | (file-exists-p | |
| 388 | (file-name-directory org-mobile-inbox-for-pull))) | |
| 389 | (error | |
| 390 | "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory")) | |
| 391 | (unless (and org-mobile-checksum-binary | |
| 392 | (string-match "\\S-" org-mobile-checksum-binary)) | |
| 393 | (error "No executable found to compute checksums")) | |
| 394 | (when org-mobile-use-encryption | |
| 395 | (unless (string-match "\\S-" (org-mobile-encryption-password)) | |
| 396 | (error | |
| 397 | "To use encryption, you must set `org-mobile-encryption-password'")) | |
| 398 | (unless (file-writable-p org-mobile-encryption-tempfile) | |
| 399 | (error "Cannot write to encryption tempfile %s" | |
| 400 | org-mobile-encryption-tempfile)) | |
| 401 | (unless (executable-find "openssl") | |
| 402 | (error "OpenSSL is needed to encrypt files")))) | |
| 403 | ||
| 404 | (defun org-mobile-create-index-file () | |
| 405 | "Write the index file in the WebDAV directory." | |
| 406 | (let ((files-alist (sort (copy-sequence org-mobile-files-alist) | |
| 407 | (lambda (a b) (string< (cdr a) (cdr b))))) | |
| 408 | (def-todo (default-value 'org-todo-keywords)) | |
| 409 | (def-tags org-tag-alist) | |
| 410 | (target-file (expand-file-name org-mobile-index-file | |
| 411 | org-mobile-directory)) | |
| 412 | todo-kwds done-kwds tags) | |
| 413 | (when (stringp (car def-todo)) | |
| 414 | (setq def-todo (list (cons 'sequence def-todo)))) | |
| 415 | (org-agenda-prepare-buffers (mapcar 'car files-alist)) | |
| 416 | (setq done-kwds (org-uniquify org-done-keywords-for-agenda)) | |
| 417 | (setq todo-kwds (org-delete-all | |
| 418 | done-kwds | |
| 419 | (org-uniquify org-todo-keywords-for-agenda))) | |
| 420 | (setq tags (mapcar 'car (org-global-tags-completion-table | |
| 421 | (mapcar 'car files-alist)))) | |
| 422 | (with-temp-file (if org-mobile-use-encryption org-mobile-encryption-tempfile | |
| 423 | target-file) | |
| 424 | (insert "#+READONLY\n") | |
| 425 | (dolist (entry def-todo) | |
| 426 | (let ((kwds (mapcar (lambda (x) | |
| 427 | (if (string-match "(" x) | |
| 428 | (substring x 0 (match-beginning 0)) | |
| 429 | x)) | |
| 430 | (cdr entry)))) | |
| 431 | (insert "#+TODO: " (mapconcat #'identity kwds " ") "\n") | |
| 432 | (let* ((dwds (or (member "|" kwds) (last kwds))) | |
| 433 | (twds (org-delete-all dwds kwds))) | |
| 434 | (setq todo-kwds (org-delete-all twds todo-kwds)) | |
| 435 | (setq done-kwds (org-delete-all dwds done-kwds))))) | |
| 436 | (when (or todo-kwds done-kwds) | |
| 437 | (insert "#+TODO: " (mapconcat 'identity todo-kwds " ") " | " | |
| 438 | (mapconcat 'identity done-kwds " ") "\n")) | |
| 439 | (setq def-tags (split-string (org-tag-alist-to-string def-tags t))) | |
| 440 | (setq tags (org-delete-all def-tags tags)) | |
| 441 | (setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b))))) | |
| 442 | (setq tags (append def-tags tags nil)) | |
| 443 | (insert "#+TAGS: " (mapconcat 'identity tags " ") "\n") | |
| 444 | (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n") | |
| 445 | (when (file-exists-p (expand-file-name | |
| 446 | org-mobile-directory "agendas.org")) | |
| 447 | (insert "* [[file:agendas.org][Agenda Views]]\n")) | |
| 448 | (pcase-dolist (`(,_ . ,link-name) files-alist) | |
| 449 | (insert (format "* [[file:%s][%s]]\n" link-name link-name))) | |
| 450 | (push (cons org-mobile-index-file (md5 (buffer-string))) | |
| 451 | org-mobile-checksum-files)) | |
| 452 | (when org-mobile-use-encryption | |
| 453 | (org-mobile-encrypt-and-move org-mobile-encryption-tempfile | |
| 454 | target-file) | |
| 455 | (org-mobile-cleanup-encryption-tempfile)))) | |
| 456 | ||
| 457 | (defun org-mobile-copy-agenda-files () | |
| 458 | "Copy all agenda files to the stage or WebDAV directory." | |
| 459 | (let ((files-alist org-mobile-files-alist) | |
| 460 | file buf entry link-name target-path target-dir check) | |
| 461 | (while (setq entry (pop files-alist)) | |
| 462 | (setq file (car entry) link-name (cdr entry)) | |
| 463 | (when (file-exists-p file) | |
| 464 | (setq target-path (expand-file-name link-name org-mobile-directory) | |
| 465 | target-dir (file-name-directory target-path)) | |
| 466 | (unless (file-directory-p target-dir) | |
| 467 | (make-directory target-dir 'parents)) | |
| 468 | (if org-mobile-use-encryption | |
| 469 | (org-mobile-encrypt-and-move file target-path) | |
| 470 | (copy-file file target-path 'ok-if-already-exists)) | |
| 471 | (setq check (shell-command-to-string | |
| 472 | (concat (shell-quote-argument org-mobile-checksum-binary) | |
| 473 | " " | |
| 474 | (shell-quote-argument (expand-file-name file))))) | |
| 475 | (when (string-match "[a-fA-F0-9]\\{30,40\\}" check) | |
| 476 | (push (cons link-name (match-string 0 check)) | |
| 477 | org-mobile-checksum-files)))) | |
| 478 | ||
| 479 | (setq file (expand-file-name org-mobile-capture-file | |
| 480 | org-mobile-directory)) | |
| 481 | (save-excursion | |
| 482 | (setq buf (find-file file)) | |
| 483 | (when (and (= (point-min) (point-max))) | |
| 484 | (insert "\n") | |
| 485 | (save-buffer) | |
| 486 | (when org-mobile-use-encryption | |
| 487 | (write-file org-mobile-encryption-tempfile) | |
| 488 | (org-mobile-encrypt-and-move org-mobile-encryption-tempfile file))) | |
| 489 | (push (cons org-mobile-capture-file (md5 (buffer-string))) | |
| 490 | org-mobile-checksum-files)) | |
| 491 | (org-mobile-cleanup-encryption-tempfile) | |
| 492 | (kill-buffer buf))) | |
| 493 | ||
| 494 | (defun org-mobile-write-checksums () | |
| 495 | "Create checksums for all files in `org-mobile-directory'. | |
| 496 | The table of checksums is written to the file mobile-checksums." | |
| 497 | (let ((sumfile (expand-file-name "checksums.dat" org-mobile-directory)) | |
| 498 | (files org-mobile-checksum-files) | |
| 499 | entry file sum) | |
| 500 | (with-temp-file sumfile | |
| 501 | (set-buffer-file-coding-system 'undecided-unix nil) | |
| 502 | (while (setq entry (pop files)) | |
| 503 | (setq file (car entry) sum (cdr entry)) | |
| 504 | (insert (format "%s %s\n" sum file)))))) | |
| 505 | ||
| 506 | (defun org-mobile-sumo-agenda-command () | |
| 507 | "Return an agenda custom command that comprises all custom commands." | |
| 508 | (let ((custom-list | |
| 509 | ;; normalize different versions | |
| 510 | (delq nil | |
| 511 | (mapcar | |
| 512 | (lambda (x) | |
| 513 | (cond ((stringp (cdr x)) nil) | |
| 514 | ((stringp (nth 1 x)) x) | |
| 515 | ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) | |
| 516 | (t (cons (car x) (cons "" (cdr x)))))) | |
| 517 | org-agenda-custom-commands))) | |
| 518 | (default-list '(("a" "Agenda" agenda) ("t" "All TODO" alltodo))) | |
| 519 | thelist atitle new e key desc type match settings cmds gkey gdesc gsettings cnt) | |
| 520 | (cond | |
| 521 | ((eq org-mobile-agendas 'custom) | |
| 522 | (setq thelist custom-list)) | |
| 523 | ((eq org-mobile-agendas 'default) | |
| 524 | (setq thelist default-list)) | |
| 525 | ((eq org-mobile-agendas 'all) | |
| 526 | (setq thelist custom-list) | |
| 527 | (unless (assoc "t" thelist) (push '("t" "ALL TODO" alltodo) thelist)) | |
| 528 | (unless (assoc "a" thelist) (push '("a" "Agenda" agenda) thelist))) | |
| 529 | ((listp org-mobile-agendas) | |
| 530 | (setq thelist (append custom-list default-list)) | |
| 531 | (setq thelist (delq nil (mapcar (lambda (k) (assoc k thelist)) | |
| 532 | org-mobile-agendas))))) | |
| 533 | (while (setq e (pop thelist)) | |
| 534 | (cond | |
| 535 | ((stringp (cdr e)) | |
| 536 | ;; this is a description entry - skip it | |
| 537 | ) | |
| 538 | ((eq (nth 2 e) 'search) | |
| 539 | ;; Search view is interactive, skip | |
| 540 | ) | |
| 541 | ((memq (nth 2 e) '(todo-tree tags-tree occur-tree)) | |
| 542 | ;; These are trees, not really agenda commands | |
| 543 | ) | |
| 544 | ((and (memq (nth 2 e) '(todo tags tags-todo)) | |
| 545 | (or (null (nth 3 e)) | |
| 546 | (not (string-match "\\S-" (nth 3 e))))) | |
| 547 | ;; These would be interactive because the match string is empty | |
| 548 | ) | |
| 549 | ((memq (nth 2 e) '(agenda alltodo todo tags tags-todo)) | |
| 550 | ;; a normal command | |
| 551 | (setq key (car e) desc (nth 1 e) type (nth 2 e) match (nth 3 e) | |
| 552 | settings (nth 4 e)) | |
| 553 | (setq settings | |
| 554 | (cons (list 'org-agenda-title-append | |
| 555 | (concat "<after>KEYS=" key " TITLE: " | |
| 556 | (if (and (stringp desc) (> (length desc) 0)) | |
| 557 | desc (symbol-name type)) | |
| 558 | "</after>")) | |
| 559 | settings)) | |
| 560 | (push (list type match settings) new)) | |
| 561 | ((or (functionp (nth 2 e)) (symbolp (nth 2 e))) | |
| 562 | ;; A user-defined function, which can do anything, so simply | |
| 563 | ;; ignore it. | |
| 564 | ) | |
| 565 | (t | |
| 566 | ;; a block agenda | |
| 567 | (setq gkey (car e) gdesc (nth 1 e) gsettings (nth 3 e) cmds (nth 2 e)) | |
| 568 | (setq cnt 0) | |
| 569 | (while (setq e (pop cmds)) | |
| 570 | (setq type (car e) match (nth 1 e) settings (nth 2 e)) | |
| 571 | (setq atitle (if (string= "" gdesc) match gdesc)) | |
| 572 | (setq settings (append gsettings settings)) | |
| 573 | (setq settings | |
| 574 | (cons (list 'org-agenda-title-append | |
| 575 | (concat "<after>KEYS=" gkey "#" (number-to-string | |
| 576 | (setq cnt (1+ cnt))) | |
| 577 | " TITLE: " atitle "</after>")) | |
| 578 | settings)) | |
| 579 | (push (list type match settings) new))))) | |
| 580 | (and new (list "X" "SUMO" (reverse new) | |
| 581 | '((org-agenda-compact-blocks nil)))))) | |
| 582 | ||
| 583 | (defvar org-mobile-creating-agendas nil) | |
| 584 | (defun org-mobile-write-agenda-for-mobile (file) | |
| 585 | (let ((all (buffer-string)) in-date id pl prefix line app short m sexp) | |
| 586 | (with-temp-file file | |
| 587 | (org-mode) | |
| 588 | (insert "#+READONLY\n") | |
| 589 | (insert all) | |
| 590 | (goto-char (point-min)) | |
| 591 | (while (not (eobp)) | |
| 592 | (cond | |
| 593 | ((looking-at "[ \t]*$")) ; keep empty lines | |
| 594 | ((looking-at "=+$") | |
| 595 | ;; remove underlining | |
| 596 | (delete-region (point) (point-at-eol))) | |
| 597 | ((get-text-property (point) 'org-agenda-structural-header) | |
| 598 | (setq in-date nil) | |
| 599 | (setq app (get-text-property (point) 'org-agenda-title-append)) | |
| 600 | (setq short (get-text-property (point) 'short-heading)) | |
| 601 | (when (and short (looking-at ".+")) | |
| 602 | (replace-match short nil t) | |
| 603 | (beginning-of-line 1)) | |
| 604 | (when app | |
| 605 | (end-of-line 1) | |
| 606 | (insert app) | |
| 607 | (beginning-of-line 1)) | |
| 608 | (insert "* ")) | |
| 609 | ((get-text-property (point) 'org-agenda-date-header) | |
| 610 | (setq in-date t) | |
| 611 | (insert "** ")) | |
| 612 | ((setq m (or (get-text-property (point) 'org-hd-marker) | |
| 613 | (get-text-property (point) 'org-marker))) | |
| 614 | (setq sexp (member (get-text-property (point) 'type) | |
| 615 | '("diary" "sexp"))) | |
| 616 | (if (setq pl (text-property-any (point) (point-at-eol) 'org-heading t)) | |
| 617 | (progn | |
| 618 | (setq prefix (org-trim (buffer-substring | |
| 619 | (point) pl)) | |
| 620 | line (org-trim (buffer-substring | |
| 621 | pl | |
| 622 | (point-at-eol)))) | |
| 623 | (delete-region (point-at-bol) (point-at-eol)) | |
| 624 | (insert line "<before>" prefix "</before>") | |
| 625 | (beginning-of-line 1)) | |
| 626 | (and (looking-at "[ \t]+") (replace-match ""))) | |
| 627 | (insert (if in-date "*** " "** ")) | |
| 628 | (end-of-line 1) | |
| 629 | (insert "\n") | |
| 630 | (unless sexp | |
| 631 | (insert (org-agenda-get-some-entry-text | |
| 632 | m 10 " " 'planning) | |
| 633 | "\n") | |
| 634 | (when (setq id | |
| 635 | (if (bound-and-true-p | |
| 636 | org-mobile-force-id-on-agenda-items) | |
| 637 | (org-id-get m 'create) | |
| 638 | (or (org-entry-get m "ID") | |
| 639 | (org-mobile-get-outline-path-link m)))) | |
| 640 | (insert " :PROPERTIES:\n :ORIGINAL_ID: " id | |
| 641 | "\n :END:\n"))))) | |
| 642 | (beginning-of-line 2)) | |
| 643 | (push (cons "agendas.org" (md5 (buffer-string))) | |
| 644 | org-mobile-checksum-files)) | |
| 645 | (message "Agenda written to Org file %s" file))) | |
| 646 | ||
| 647 | (defun org-mobile-get-outline-path-link (pom) | |
| 648 | (org-with-point-at pom | |
| 649 | (concat "olp:" | |
| 650 | (org-mobile-escape-olp (file-name-nondirectory buffer-file-name)) | |
| 651 | ":" | |
| 652 | (mapconcat 'org-mobile-escape-olp | |
| 653 | (org-get-outline-path) | |
| 654 | "/") | |
| 655 | "/" | |
| 656 | (org-mobile-escape-olp (nth 4 (org-heading-components)))))) | |
| 657 | ||
| 658 | (defun org-mobile-escape-olp (s) | |
| 659 | (let ((table '(?: ?/))) | |
| 660 | (org-link-escape s table))) | |
| 661 | ||
| 662 | (defun org-mobile-create-sumo-agenda () | |
| 663 | "Create a file that contains all custom agenda views." | |
| 664 | (interactive) | |
| 665 | (let* ((file (expand-file-name "agendas.org" | |
| 666 | org-mobile-directory)) | |
| 667 | (file1 (if org-mobile-use-encryption | |
| 668 | org-mobile-encryption-tempfile | |
| 669 | file)) | |
| 670 | (sumo (org-mobile-sumo-agenda-command)) | |
| 671 | (org-agenda-custom-commands | |
| 672 | (list (append sumo (list (list file1))))) | |
| 673 | (org-mobile-creating-agendas t)) | |
| 674 | (unless (file-writable-p file1) | |
| 675 | (error "Cannot write to file %s" file1)) | |
| 676 | (when sumo | |
| 677 | (org-store-agenda-views)) | |
| 678 | (when org-mobile-use-encryption | |
| 679 | (org-mobile-encrypt-and-move file1 file) | |
| 680 | (delete-file file1) | |
| 681 | (org-mobile-cleanup-encryption-tempfile)))) | |
| 682 | ||
| 683 | (defun org-mobile-encrypt-and-move (infile outfile) | |
| 684 | "Encrypt INFILE locally to INFILE_enc, then move it to OUTFILE. | |
| 685 | We do this in two steps so that remote paths will work, even if the | |
| 686 | encryption program does not understand them." | |
| 687 | (let ((encfile (concat infile "_enc"))) | |
| 688 | (org-mobile-encrypt-file infile encfile) | |
| 689 | (when outfile | |
| 690 | (copy-file encfile outfile 'ok-if-already-exists) | |
| 691 | (delete-file encfile)))) | |
| 692 | ||
| 693 | (defun org-mobile-encrypt-file (infile outfile) | |
| 694 | "Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." | |
| 695 | (shell-command | |
| 696 | (format "openssl enc -md md5 -aes-256-cbc -salt -pass %s -in %s -out %s" | |
| 697 | (shell-quote-argument (concat "pass:" | |
| 698 | (org-mobile-encryption-password))) | |
| 699 | (shell-quote-argument (expand-file-name infile)) | |
| 700 | (shell-quote-argument (expand-file-name outfile))))) | |
| 701 | ||
| 702 | (defun org-mobile-decrypt-file (infile outfile) | |
| 703 | "Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." | |
| 704 | (shell-command | |
| 705 | (format "openssl enc -md md5 -d -aes-256-cbc -salt -pass %s -in %s -out %s" | |
| 706 | (shell-quote-argument (concat "pass:" | |
| 707 | (org-mobile-encryption-password))) | |
| 708 | (shell-quote-argument (expand-file-name infile)) | |
| 709 | (shell-quote-argument (expand-file-name outfile))))) | |
| 710 | ||
| 711 | (defun org-mobile-cleanup-encryption-tempfile () | |
| 712 | "Remove the encryption tempfile if it exists." | |
| 713 | (and (stringp org-mobile-encryption-tempfile) | |
| 714 | (file-exists-p org-mobile-encryption-tempfile) | |
| 715 | (delete-file org-mobile-encryption-tempfile))) | |
| 716 | ||
| 717 | (defun org-mobile-move-capture () | |
| 718 | "Move the contents of the capture file to the inbox file. | |
| 719 | Return a marker to the location where the new content has been added. | |
| 720 | If nothing new has been added, return nil." | |
| 721 | (interactive) | |
| 722 | (let* ((encfile nil) | |
| 723 | (capture-file (expand-file-name org-mobile-capture-file | |
| 724 | org-mobile-directory)) | |
| 725 | (inbox-buffer (find-file-noselect org-mobile-inbox-for-pull)) | |
| 726 | (capture-buffer | |
| 727 | (if (not org-mobile-use-encryption) | |
| 728 | (find-file-noselect capture-file) | |
| 729 | (org-mobile-cleanup-encryption-tempfile) | |
| 730 | (setq encfile (concat org-mobile-encryption-tempfile "_enc")) | |
| 731 | (copy-file capture-file encfile) | |
| 732 | (org-mobile-decrypt-file encfile org-mobile-encryption-tempfile) | |
| 733 | (find-file-noselect org-mobile-encryption-tempfile))) | |
| 734 | (insertion-point (make-marker)) | |
| 735 | not-empty content) | |
| 736 | (with-current-buffer capture-buffer | |
| 737 | (setq content (buffer-string)) | |
| 738 | (setq not-empty (string-match "\\S-" content)) | |
| 739 | (when not-empty | |
| 740 | (set-buffer inbox-buffer) | |
| 741 | (widen) | |
| 742 | (goto-char (point-max)) | |
| 743 | (or (bolp) (newline)) | |
| 744 | (move-marker insertion-point | |
| 745 | (prog1 (point) (insert content))) | |
| 746 | (save-buffer) | |
| 747 | (set-buffer capture-buffer) | |
| 748 | (erase-buffer) | |
| 749 | (save-buffer) | |
| 750 | (org-mobile-update-checksum-for-capture-file (buffer-string)))) | |
| 751 | (kill-buffer capture-buffer) | |
| 752 | (when org-mobile-use-encryption | |
| 753 | (org-mobile-encrypt-and-move org-mobile-encryption-tempfile | |
| 754 | capture-file) | |
| 755 | (org-mobile-cleanup-encryption-tempfile)) | |
| 756 | (if not-empty insertion-point))) | |
| 757 | ||
| 758 | (defun org-mobile-update-checksum-for-capture-file (buffer-string) | |
| 759 | "Find the checksum line and modify it to match BUFFER-STRING." | |
| 760 | (let* ((file (expand-file-name "checksums.dat" org-mobile-directory)) | |
| 761 | (buffer (find-file-noselect file))) | |
| 762 | (when buffer | |
| 763 | (with-current-buffer buffer | |
| 764 | (when (re-search-forward (concat "\\([0-9a-fA-F]\\{30,\\}\\).*?" | |
| 765 | (regexp-quote org-mobile-capture-file) | |
| 766 | "[ \t]*$") nil t) | |
| 767 | (goto-char (match-beginning 1)) | |
| 768 | (delete-region (match-beginning 1) (match-end 1)) | |
| 769 | (insert (md5 buffer-string)) | |
| 770 | (save-buffer))) | |
| 771 | (kill-buffer buffer)))) | |
| 772 | ||
| 773 | (defun org-mobile-apply (&optional beg end) | |
| 774 | "Apply all change requests in the current buffer. | |
| 775 | If BEG and END are given, only do this in that region." | |
| 776 | (interactive) | |
| 777 | (require 'org-archive) | |
| 778 | (setq org-mobile-last-flagged-files nil) | |
| 779 | (setq beg (or beg (point-min)) end (or end (point-max))) | |
| 780 | ||
| 781 | ;; Remove all Note IDs | |
| 782 | (goto-char beg) | |
| 783 | (while (re-search-forward "^\\*\\* Note ID: [-0-9A-F]+[ \t]*\n" end t) | |
| 784 | (replace-match "")) | |
| 785 | ||
| 786 | ;; Find all the referenced entries, without making any changes yet | |
| 787 | (let ((marker (make-marker)) | |
| 788 | (bos-marker (make-marker)) | |
| 789 | (end (move-marker (make-marker) end)) | |
| 790 | (cnt-new 0) | |
| 791 | (cnt-edit 0) | |
| 792 | (cnt-flag 0) | |
| 793 | (cnt-error 0) | |
| 794 | buf-list | |
| 795 | org-mobile-error) | |
| 796 | ||
| 797 | ;; Count the new captures | |
| 798 | (goto-char beg) | |
| 799 | (while (re-search-forward "^\\* \\(.*\\)" end t) | |
| 800 | (and (>= (- (match-end 1) (match-beginning 1)) 2) | |
| 801 | (not (equal (downcase (substring (match-string 1) 0 2)) "f(")) | |
| 802 | (cl-incf cnt-new))) | |
| 803 | ||
| 804 | ;; Find and apply the edits | |
| 805 | (goto-char beg) | |
| 806 | (while (re-search-forward | |
| 807 | "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[\\(\\(id\\|olp\\):\\([^]\n]+\\)\\)" end t) | |
| 808 | (catch 'next | |
| 809 | (let* ((action (match-string 1)) | |
| 810 | (data (and (match-end 3) (match-string 3))) | |
| 811 | (id-pos (condition-case msg | |
| 812 | (org-mobile-locate-entry (match-string 4)) | |
| 813 | (error (nth 1 msg)))) | |
| 814 | (bos (line-beginning-position)) | |
| 815 | (eos (save-excursion (org-end-of-subtree t t))) | |
| 816 | (cmd (if (equal action "") | |
| 817 | (let ((note (buffer-substring-no-properties | |
| 818 | (line-beginning-position 2) eos))) | |
| 819 | (lambda (_data _old _new) | |
| 820 | (cl-incf cnt-flag) | |
| 821 | (org-toggle-tag "FLAGGED" 'on) | |
| 822 | (org-entry-put | |
| 823 | nil "THEFLAGGINGNOTE" | |
| 824 | (replace-regexp-in-string "\n" "\\\\n" note)))) | |
| 825 | (cl-incf cnt-edit) | |
| 826 | (cdr (assoc action org-mobile-action-alist)))) | |
| 827 | ;; Do not take notes interactively. | |
| 828 | (org-inhibit-logging 'note) | |
| 829 | old new) | |
| 830 | ||
| 831 | (goto-char bos) | |
| 832 | (when (and (markerp id-pos) | |
| 833 | (not (member (marker-buffer id-pos) buf-list))) | |
| 834 | (org-mobile-timestamp-buffer (marker-buffer id-pos)) | |
| 835 | (push (marker-buffer id-pos) buf-list)) | |
| 836 | (unless (markerp id-pos) | |
| 837 | (goto-char (+ 2 (point-at-bol))) | |
| 838 | (if (stringp id-pos) | |
| 839 | (insert id-pos " ") | |
| 840 | (insert "BAD REFERENCE ")) | |
| 841 | (cl-incf cnt-error) | |
| 842 | (throw 'next t)) | |
| 843 | (unless cmd | |
| 844 | (insert "BAD FLAG ") | |
| 845 | (cl-incf cnt-error) | |
| 846 | (throw 'next t)) | |
| 847 | (move-marker bos-marker (point)) | |
| 848 | (if (re-search-forward "^** Old value[ \t]*$" eos t) | |
| 849 | (setq old (buffer-substring | |
| 850 | (1+ (match-end 0)) | |
| 851 | (progn (outline-next-heading) (point))))) | |
| 852 | (if (re-search-forward "^** New value[ \t]*$" eos t) | |
| 853 | (setq new (buffer-substring | |
| 854 | (1+ (match-end 0)) | |
| 855 | (progn (outline-next-heading) | |
| 856 | (if (eobp) (org-back-over-empty-lines)) | |
| 857 | (point))))) | |
| 858 | (setq old (org-string-nw-p old)) | |
| 859 | (setq new (org-string-nw-p new)) | |
| 860 | (unless (equal data "body") | |
| 861 | (setq new (and new (org-trim new))) | |
| 862 | (setq old (and old (org-trim old)))) | |
| 863 | (goto-char (+ 2 bos-marker)) | |
| 864 | ;; Remember this place so that we can return | |
| 865 | (move-marker marker (point)) | |
| 866 | (setq org-mobile-error nil) | |
| 867 | (condition-case msg | |
| 868 | (org-with-point-at id-pos | |
| 869 | (funcall cmd data old new) | |
| 870 | (unless (member data '("delete" "archive" "archive-sibling" | |
| 871 | "addheading")) | |
| 872 | (when (member "FLAGGED" (org-get-tags)) | |
| 873 | (add-to-list 'org-mobile-last-flagged-files | |
| 874 | (buffer-file-name))))) | |
| 875 | (error (setq org-mobile-error msg))) | |
| 876 | (when org-mobile-error | |
| 877 | (pop-to-buffer-same-window (marker-buffer marker)) | |
| 878 | (goto-char marker) | |
| 879 | (cl-incf cnt-error) | |
| 880 | (insert (if (stringp (nth 1 org-mobile-error)) | |
| 881 | (nth 1 org-mobile-error) | |
| 882 | "EXECUTION FAILED") | |
| 883 | " ") | |
| 884 | (throw 'next t)) | |
| 885 | ;; If we get here, the action has been applied successfully | |
| 886 | ;; So remove the entry | |
| 887 | (goto-char bos-marker) | |
| 888 | (delete-region (point) (org-end-of-subtree t t))))) | |
| 889 | (save-buffer) | |
| 890 | (move-marker marker nil) | |
| 891 | (move-marker end nil) | |
| 892 | (message "%d new, %d edits, %d flags, %d errors" | |
| 893 | cnt-new cnt-edit cnt-flag cnt-error) | |
| 894 | (sit-for 1))) | |
| 895 | ||
| 896 | (defun org-mobile-timestamp-buffer (buf) | |
| 897 | "Time stamp buffer BUF, just to make sure its checksum will change." | |
| 898 | (with-current-buffer buf | |
| 899 | (save-excursion | |
| 900 | (save-restriction | |
| 901 | (widen) | |
| 902 | (goto-char (point-min)) | |
| 903 | (if (re-search-forward | |
| 904 | "^\\([ \t]*\\)#\\+LAST_MOBILE_CHANGE:.*\n?" nil t) | |
| 905 | (progn | |
| 906 | (goto-char (match-end 1)) | |
| 907 | (delete-region (point) (match-end 0))) | |
| 908 | (if (looking-at ".*?-\\*-.*-\\*-") | |
| 909 | (forward-line 1))) | |
| 910 | (insert "#+LAST_MOBILE_CHANGE: " | |
| 911 | (format-time-string "%Y-%m-%d %T") "\n"))))) | |
| 912 | ||
| 913 | (defun org-mobile-smart-read () | |
| 914 | "Parse the entry at point for shortcuts and expand them. | |
| 915 | These shortcuts are meant for fast and easy typing on the limited | |
| 916 | keyboards of a mobile device. Below we show a list of the shortcuts | |
| 917 | currently implemented. | |
| 918 | ||
| 919 | The entry is expected to contain an inactive time stamp indicating when | |
| 920 | the entry was created. When setting dates and | |
| 921 | times (for example for deadlines), the time strings are interpreted | |
| 922 | relative to that creation date. | |
| 923 | Abbreviations are expected to take up entire lines, just because it is so | |
| 924 | easy to type RET on a mobile device. Abbreviations start with one or two | |
| 925 | letters, followed immediately by a dot and then additional information. | |
| 926 | Generally the entire shortcut line is removed after action have been taken. | |
| 927 | Time stamps will be constructed using `org-read-date'. So for example a | |
| 928 | line \"dd. 2tue\" will set a deadline on the second Tuesday after the | |
| 929 | creation date. | |
| 930 | ||
| 931 | Here are the shortcuts currently implemented: | |
| 932 | ||
| 933 | dd. string set deadline | |
| 934 | ss. string set scheduling | |
| 935 | tt. string set time tamp, here. | |
| 936 | ti. string set inactive time | |
| 937 | ||
| 938 | tg. tag1 tag2 tag3 set all these tags, change case where necessary | |
| 939 | td. kwd set this todo keyword, change case where necessary | |
| 940 | ||
| 941 | FIXME: Hmmm, not sure if we can make his work against the | |
| 942 | auto-correction feature. Needs a bit more thinking. So this function | |
| 943 | is currently a noop.") | |
| 944 | ||
| 945 | (defun org-mobile-locate-entry (link) | |
| 946 | (if (string-match "\\`id:\\(.*\\)$" link) | |
| 947 | (org-id-find (match-string 1 link) 'marker) | |
| 948 | (if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link)) | |
| 949 | ; not found with path, but maybe it is to be inserted | |
| 950 | ; in top level of the file? | |
| 951 | (if (not (string-match "\\`olp:\\(.*?\\)$" link)) | |
| 952 | nil | |
| 953 | (let ((file (match-string 1 link))) | |
| 954 | (setq file (org-link-unescape file)) | |
| 955 | (setq file (expand-file-name file org-directory)) | |
| 956 | (save-excursion | |
| 957 | (find-file file) | |
| 958 | (goto-char (point-max)) | |
| 959 | (newline) | |
| 960 | (goto-char (point-max)) | |
| 961 | (point-marker)))) | |
| 962 | (let ((file (match-string 1 link)) | |
| 963 | (path (match-string 2 link))) | |
| 964 | (setq file (org-link-unescape file)) | |
| 965 | (setq file (expand-file-name file org-directory)) | |
| 966 | (setq path (mapcar 'org-link-unescape | |
| 967 | (org-split-string path "/"))) | |
| 968 | (org-find-olp (cons file path)))))) | |
| 969 | ||
| 970 | (defun org-mobile-edit (what old new) | |
| 971 | "Edit item WHAT in the current entry by replacing OLD with NEW. | |
| 972 | WHAT can be \"heading\", \"todo\", \"tags\", \"priority\", or \"body\". | |
| 973 | The edit only takes place if the current value is equal (except for | |
| 974 | white space) the OLD. If this is so, OLD will be replace by NEW | |
| 975 | and the command will return t. If something goes wrong, a string will | |
| 976 | be returned that indicates what went wrong." | |
| 977 | (let (current old1 new1 level) | |
| 978 | (if (stringp what) (setq what (intern what))) | |
| 979 | ||
| 980 | (cond | |
| 981 | ||
| 982 | ((memq what '(todo todostate)) | |
| 983 | (setq current (org-get-todo-state)) | |
| 984 | (cond | |
| 985 | ((equal new "DONEARCHIVE") | |
| 986 | (org-todo 'done) | |
| 987 | (org-archive-subtree-default)) | |
| 988 | ((equal new current) t) ; nothing needs to be done | |
| 989 | ((or (equal current old) | |
| 990 | (eq org-mobile-force-mobile-change t) | |
| 991 | (memq 'todo org-mobile-force-mobile-change)) | |
| 992 | (org-todo (or new 'none)) t) | |
| 993 | (t (error "State before change was expected as \"%s\", but is \"%s\"" | |
| 994 | old current)))) | |
| 995 | ||
| 996 | ((eq what 'tags) | |
| 997 | (setq current (org-get-tags) | |
| 998 | new1 (and new (org-split-string new ":+")) | |
| 999 | old1 (and old (org-split-string old ":+"))) | |
| 1000 | (cond | |
| 1001 | ((org-mobile-tags-same-p current new1) t) ; no change needed | |
| 1002 | ((or (org-mobile-tags-same-p current old1) | |
| 1003 | (eq org-mobile-force-mobile-change t) | |
| 1004 | (memq 'tags org-mobile-force-mobile-change)) | |
| 1005 | (org-set-tags-to new1) t) | |
| 1006 | (t (error "Tags before change were expected as \"%s\", but are \"%s\"" | |
| 1007 | (or old "") (or current ""))))) | |
| 1008 | ||
| 1009 | ((eq what 'priority) | |
| 1010 | (let ((case-fold-search nil)) | |
| 1011 | (when (looking-at org-complex-heading-regexp) | |
| 1012 | (let ((current (and (match-end 3) (substring (match-string 3) 2 3)))) | |
| 1013 | (cond | |
| 1014 | ((equal current new) t) ;no action required | |
| 1015 | ((or (equal current old) | |
| 1016 | (eq org-mobile-force-mobile-change t) | |
| 1017 | (memq 'tags org-mobile-force-mobile-change)) | |
| 1018 | (org-priority (and new (string-to-char new)))) | |
| 1019 | (t (error "Priority was expected to be %s, but is %s" | |
| 1020 | old current))))))) | |
| 1021 | ||
| 1022 | ((eq what 'heading) | |
| 1023 | (let ((case-fold-search nil)) | |
| 1024 | (when (looking-at org-complex-heading-regexp) | |
| 1025 | (let ((current (match-string 4))) | |
| 1026 | (cond | |
| 1027 | ((equal current new) t) ;no action required | |
| 1028 | ((or (equal current old) | |
| 1029 | (eq org-mobile-force-mobile-change t) | |
| 1030 | (memq 'heading org-mobile-force-mobile-change)) | |
| 1031 | (goto-char (match-beginning 4)) | |
| 1032 | (insert new) | |
| 1033 | (delete-region (point) (+ (point) (length current))) | |
| 1034 | (org-set-tags nil 'align)) | |
| 1035 | (t (error "Heading changed in MobileOrg and on the computer"))))))) | |
| 1036 | ||
| 1037 | ((eq what 'addheading) | |
| 1038 | (if (org-at-heading-p) ; if false we are in top-level of file | |
| 1039 | (progn | |
| 1040 | ;; Workaround a `org-insert-heading-respect-content' bug | |
| 1041 | ;; which prevents correct insertion when point is invisible | |
| 1042 | (org-show-subtree) | |
| 1043 | (end-of-line 1) | |
| 1044 | (org-insert-heading-respect-content t) | |
| 1045 | (org-demote)) | |
| 1046 | (beginning-of-line) | |
| 1047 | (insert "* ")) | |
| 1048 | (insert new)) | |
| 1049 | ||
| 1050 | ((eq what 'refile) | |
| 1051 | (org-copy-subtree) | |
| 1052 | (org-with-point-at (org-mobile-locate-entry new) | |
| 1053 | (if (org-at-heading-p) ; if false we are in top-level of file | |
| 1054 | (progn | |
| 1055 | (setq level (org-get-valid-level (funcall outline-level) 1)) | |
| 1056 | (org-end-of-subtree t t) | |
| 1057 | (org-paste-subtree level)) | |
| 1058 | (org-paste-subtree 1))) | |
| 1059 | (org-cut-subtree)) | |
| 1060 | ||
| 1061 | ((eq what 'delete) | |
| 1062 | (org-cut-subtree)) | |
| 1063 | ||
| 1064 | ((eq what 'archive) | |
| 1065 | (org-archive-subtree)) | |
| 1066 | ||
| 1067 | ((eq what 'archive-sibling) | |
| 1068 | (org-archive-to-archive-sibling)) | |
| 1069 | ||
| 1070 | ((eq what 'body) | |
| 1071 | (setq current (buffer-substring (min (1+ (point-at-eol)) (point-max)) | |
| 1072 | (save-excursion (outline-next-heading) | |
| 1073 | (point)))) | |
| 1074 | (if (not (string-match "\\S-" current)) (setq current nil)) | |
| 1075 | (cond | |
| 1076 | ((org-mobile-bodies-same-p current new) t) ; no action necessary | |
| 1077 | ((or (org-mobile-bodies-same-p current old) | |
| 1078 | (eq org-mobile-force-mobile-change t) | |
| 1079 | (memq 'body org-mobile-force-mobile-change)) | |
| 1080 | (save-excursion | |
| 1081 | (end-of-line 1) | |
| 1082 | (insert "\n" new) | |
| 1083 | (or (bolp) (insert "\n")) | |
| 1084 | (delete-region (point) (progn (org-back-to-heading t) | |
| 1085 | (outline-next-heading) | |
| 1086 | (point)))) | |
| 1087 | t) | |
| 1088 | (t (error "Body was changed in MobileOrg and on the computer"))))))) | |
| 1089 | ||
| 1090 | (defun org-mobile-tags-same-p (list1 list2) | |
| 1091 | "Are the two tag lists the same?" | |
| 1092 | (not (or (org-delete-all list1 list2) | |
| 1093 | (org-delete-all list2 list1)))) | |
| 1094 | ||
| 1095 | (defun org-mobile-bodies-same-p (a b) | |
| 1096 | "Compare if A and B are visually equal strings. | |
| 1097 | We first remove leading and trailing white space from the entire strings. | |
| 1098 | Then we split the strings into lines and remove leading/trailing whitespace | |
| 1099 | from each line. Then we compare. | |
| 1100 | A and B must be strings or nil." | |
| 1101 | (cond | |
| 1102 | ((and (not a) (not b)) t) | |
| 1103 | ((or (not a) (not b)) nil) | |
| 1104 | (t (setq a (org-trim a) b (org-trim b)) | |
| 1105 | (setq a (mapconcat 'identity (org-split-string a "[ \t]*\n[ \t]*") "\n")) | |
| 1106 | (setq b (mapconcat 'identity (org-split-string b "[ \t]*\n[ \t]*") "\n")) | |
| 1107 | (equal a b)))) | |
| 1108 | ||
| 1109 | (provide 'org-mobile) | |
| 1110 | ||
| 1111 | ;; Local variables: | |
| 1112 | ;; generated-autoload-file: "org-loaddefs.el" | |
| 1113 | ;; End: | |
| 1114 | ||
| 1115 | ;;; org-mobile.el ends here | |
