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