org-mobile: Added five new targets for edit nodes
* lisp/org-mobile.el (org-mobile-edit): Added handling of addheading, refile, archive, archive-sibling and delete edit nodes. (org-mobile-locate-entry): olp links containing only a file are now be located correctly. (org-mobile-apply): Instead of finding the location of all target headings for edit nodes in a separate loop, they will be found immediately before applying edits. org-mobile-apply needed to be changed, as the new edit nodes can insert new headings or delete them, thereby changing the locations of the target headings. Thanks to Aaron Peromsik for helping with this patch.
This commit is contained in:
parent
a6e4dcfb4d
commit
29d17bd1e8
|
@ -829,37 +829,16 @@ If BEG and END are given, only do this in that region."
|
||||||
(not (equal (downcase (substring (match-string 1) 0 2)) "f("))
|
(not (equal (downcase (substring (match-string 1) 0 2)) "f("))
|
||||||
(incf cnt-new)))
|
(incf cnt-new)))
|
||||||
|
|
||||||
|
;; Find and apply the edits
|
||||||
(goto-char beg)
|
(goto-char beg)
|
||||||
(while (re-search-forward
|
(while (re-search-forward
|
||||||
"^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[\\(\\(id\\|olp\\):\\([^]\n]+\\)\\)" end t)
|
"^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[\\(\\(id\\|olp\\):\\([^]\n]+\\)\\)" end t)
|
||||||
(setq id-pos (condition-case msg
|
|
||||||
(org-mobile-locate-entry (match-string 4))
|
|
||||||
(error (nth 1 msg))))
|
|
||||||
(when (and (markerp id-pos)
|
|
||||||
(not (member (marker-buffer id-pos) buf-list)))
|
|
||||||
(org-mobile-timestamp-buffer (marker-buffer id-pos))
|
|
||||||
(push (marker-buffer id-pos) buf-list))
|
|
||||||
|
|
||||||
(if (or (not id-pos) (stringp id-pos))
|
|
||||||
(progn
|
|
||||||
(goto-char (+ 2 (point-at-bol)))
|
|
||||||
(insert id-pos " ")
|
|
||||||
(incf cnt-error))
|
|
||||||
(add-text-properties (point-at-bol) (point-at-eol)
|
|
||||||
(list 'org-mobile-marker
|
|
||||||
(or id-pos "Linked entry not found")))))
|
|
||||||
|
|
||||||
;; OK, now go back and start applying
|
|
||||||
(goto-char beg)
|
|
||||||
(while (re-search-forward "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)" end t)
|
|
||||||
(catch 'next
|
(catch 'next
|
||||||
(setq id-pos (get-text-property (point-at-bol) 'org-mobile-marker))
|
|
||||||
(if (not (markerp id-pos))
|
|
||||||
(progn
|
|
||||||
(incf cnt-error)
|
|
||||||
(insert "UNKNOWN PROBLEM"))
|
|
||||||
(let* ((action (match-string 1))
|
(let* ((action (match-string 1))
|
||||||
(data (and (match-end 3) (match-string 3)))
|
(data (and (match-end 3) (match-string 3)))
|
||||||
|
(id-pos (condition-case msg
|
||||||
|
(org-mobile-locate-entry (match-string 4))
|
||||||
|
(error (nth 1 msg))))
|
||||||
(bos (point-at-bol))
|
(bos (point-at-bol))
|
||||||
(eos (save-excursion (org-end-of-subtree t t)))
|
(eos (save-excursion (org-end-of-subtree t t)))
|
||||||
(cmd (if (equal action "")
|
(cmd (if (equal action "")
|
||||||
|
@ -874,7 +853,23 @@ If BEG and END are given, only do this in that region."
|
||||||
(buffer-substring (1+ (point-at-eol)) eos)))
|
(buffer-substring (1+ (point-at-eol)) eos)))
|
||||||
(org-inhibit-logging 'note) ;; Do not take notes interactively
|
(org-inhibit-logging 'note) ;; Do not take notes interactively
|
||||||
old new)
|
old new)
|
||||||
|
|
||||||
(goto-char bos)
|
(goto-char bos)
|
||||||
|
(when (and (markerp id-pos)
|
||||||
|
(not (member (marker-buffer id-pos) buf-list)))
|
||||||
|
(org-mobile-timestamp-buffer (marker-buffer id-pos))
|
||||||
|
(push (marker-buffer id-pos) buf-list))
|
||||||
|
(unless (markerp id-pos)
|
||||||
|
(goto-char (+ 2 (point-at-bol)))
|
||||||
|
(if (stringp id-pos)
|
||||||
|
(insert id-pos " ")
|
||||||
|
(insert "BAD REFERENCE "))
|
||||||
|
(incf cnt-error)
|
||||||
|
(throw 'next t))
|
||||||
|
(unless cmd
|
||||||
|
(insert "BAD FLAG ")
|
||||||
|
(incf cnt-error)
|
||||||
|
(throw 'next t))
|
||||||
(move-marker bos-marker (point))
|
(move-marker bos-marker (point))
|
||||||
(if (re-search-forward "^** Old value[ \t]*$" eos t)
|
(if (re-search-forward "^** Old value[ \t]*$" eos t)
|
||||||
(setq old (buffer-substring
|
(setq old (buffer-substring
|
||||||
|
@ -897,14 +892,6 @@ If BEG and END are given, only do this in that region."
|
||||||
(setq new (and new (org-trim new))
|
(setq new (and new (org-trim new))
|
||||||
old (and old (org-trim old))))
|
old (and old (org-trim old))))
|
||||||
(goto-char (+ 2 bos-marker))
|
(goto-char (+ 2 bos-marker))
|
||||||
(unless (markerp id-pos)
|
|
||||||
(insert "BAD REFERENCE ")
|
|
||||||
(incf cnt-error)
|
|
||||||
(throw 'next t))
|
|
||||||
(unless cmd
|
|
||||||
(insert "BAD FLAG ")
|
|
||||||
(incf cnt-error)
|
|
||||||
(throw 'next t))
|
|
||||||
;; Remember this place so that we can return
|
;; Remember this place so that we can return
|
||||||
(move-marker marker (point))
|
(move-marker marker (point))
|
||||||
(setq org-mobile-error nil)
|
(setq org-mobile-error nil)
|
||||||
|
@ -913,9 +900,10 @@ If BEG and END are given, only do this in that region."
|
||||||
(org-with-point-at id-pos
|
(org-with-point-at id-pos
|
||||||
(progn
|
(progn
|
||||||
(eval cmd)
|
(eval cmd)
|
||||||
(if (member "FLAGGED" (org-get-tags))
|
(unless (member data (list "delete" "archive" "archive-sibling" "addheading"))
|
||||||
|
(if (member "FLAGGED" (org-get-tags))
|
||||||
(add-to-list 'org-mobile-last-flagged-files
|
(add-to-list 'org-mobile-last-flagged-files
|
||||||
(buffer-file-name (current-buffer))))))
|
(buffer-file-name (current-buffer)))))))
|
||||||
(error (setq org-mobile-error msg))))
|
(error (setq org-mobile-error msg))))
|
||||||
(when org-mobile-error
|
(when org-mobile-error
|
||||||
(org-pop-to-buffer-same-window (marker-buffer marker))
|
(org-pop-to-buffer-same-window (marker-buffer marker))
|
||||||
|
@ -929,7 +917,7 @@ If BEG and END are given, only do this in that region."
|
||||||
;; If we get here, the action has been applied successfully
|
;; If we get here, the action has been applied successfully
|
||||||
;; So remove the entry
|
;; So remove the entry
|
||||||
(goto-char bos-marker)
|
(goto-char bos-marker)
|
||||||
(delete-region (point) (org-end-of-subtree t t))))))
|
(delete-region (point) (org-end-of-subtree t t)))))
|
||||||
(save-buffer)
|
(save-buffer)
|
||||||
(move-marker marker nil)
|
(move-marker marker nil)
|
||||||
(move-marker end nil)
|
(move-marker end nil)
|
||||||
|
@ -990,7 +978,19 @@ is currently a noop.")
|
||||||
(if (string-match "\\`id:\\(.*\\)$" link)
|
(if (string-match "\\`id:\\(.*\\)$" link)
|
||||||
(org-id-find (match-string 1 link) 'marker)
|
(org-id-find (match-string 1 link) 'marker)
|
||||||
(if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link))
|
(if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link))
|
||||||
nil
|
; not found with path, but maybe it is to be inserted
|
||||||
|
; in top level of the file?
|
||||||
|
(if (not (string-match "\\`olp:\\(.*?\\)$" link))
|
||||||
|
nil
|
||||||
|
(let ((file (match-string 1 link)))
|
||||||
|
(setq file (org-link-unescape file))
|
||||||
|
(setq file (expand-file-name file org-directory))
|
||||||
|
(save-excursion
|
||||||
|
(find-file file)
|
||||||
|
(goto-char (point-max))
|
||||||
|
(newline)
|
||||||
|
(goto-char (point-max))
|
||||||
|
(move-marker (make-marker) (point)))))
|
||||||
(let ((file (match-string 1 link))
|
(let ((file (match-string 1 link))
|
||||||
(path (match-string 2 link)))
|
(path (match-string 2 link)))
|
||||||
(setq file (org-link-unescape file))
|
(setq file (org-link-unescape file))
|
||||||
|
@ -1064,6 +1064,36 @@ be returned that indicates what went wrong."
|
||||||
(org-set-tags nil 'align))
|
(org-set-tags nil 'align))
|
||||||
(t (error "Heading changed in MobileOrg and on the computer")))))
|
(t (error "Heading changed in MobileOrg and on the computer")))))
|
||||||
|
|
||||||
|
((eq what 'addheading)
|
||||||
|
(if (org-on-heading-p) ; if false we are in top-level of file
|
||||||
|
(progn
|
||||||
|
(end-of-line 1)
|
||||||
|
(org-insert-heading-respect-content)
|
||||||
|
(org-demote))
|
||||||
|
(beginning-of-line)
|
||||||
|
(insert "* "))
|
||||||
|
(insert new))
|
||||||
|
|
||||||
|
((eq what 'refile)
|
||||||
|
(org-copy-subtree)
|
||||||
|
(org-with-point-at (org-mobile-locate-entry new)
|
||||||
|
(if (org-on-heading-p) ; if false we are in top-level of file
|
||||||
|
(progn
|
||||||
|
(setq level (org-get-valid-level (funcall outline-level) 1))
|
||||||
|
(org-end-of-subtree t t)
|
||||||
|
(org-paste-subtree level))
|
||||||
|
(org-paste-subtree 1)))
|
||||||
|
(org-cut-subtree))
|
||||||
|
|
||||||
|
((eq what 'delete)
|
||||||
|
(org-cut-subtree))
|
||||||
|
|
||||||
|
((eq what 'archive)
|
||||||
|
(org-archive-subtree))
|
||||||
|
|
||||||
|
((eq what 'archive-sibling)
|
||||||
|
(org-archive-to-archive-sibling))
|
||||||
|
|
||||||
((eq what 'body)
|
((eq what 'body)
|
||||||
(setq current (buffer-substring (min (1+ (point-at-eol)) (point-max))
|
(setq current (buffer-substring (min (1+ (point-at-eol)) (point-max))
|
||||||
(save-excursion (outline-next-heading)
|
(save-excursion (outline-next-heading)
|
||||||
|
|
Loading…
Reference in New Issue