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