1
0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-22 07:09:47 +00:00

Move a function to org.el

* lisp/org.el (org-find-olp): Move the function here, from org-mobile.el
This commit is contained in:
Carsten Dominik 2010-05-31 18:52:09 +02:00
parent ea3cdc75f8
commit d34786f227
2 changed files with 47 additions and 40 deletions

View File

@ -902,42 +902,6 @@ FIXME: Hmmm, not sure if we can make his work against the
auto-correction feature. Needs a bit more thinking. So this function
is currently a noop.")
(defun org-find-olp (path)
"Return a marker pointing to the entry at outline path OLP.
If anything goes wrong, the return value will instead an error message,
as a string."
(let* ((file (pop path))
(buffer (find-file-noselect file))
(level 1)
(lmin 1)
(lmax 1)
limit re end found pos heading cnt)
(unless buffer (error "File not found :%s" file))
(with-current-buffer buffer
(save-excursion
(save-restriction
(widen)
(setq limit (point-max))
(goto-char (point-min))
(while (setq heading (pop path))
(setq re (format org-complex-heading-regexp-format
(regexp-quote heading)))
(setq cnt 0 pos (point))
(while (re-search-forward re end t)
(setq level (- (match-end 1) (match-beginning 1)))
(if (and (>= level lmin) (<= level lmax))
(setq found (match-beginning 0) cnt (1+ cnt))))
(when (= cnt 0) (error "Heading not found on level %d: %s"
lmax heading))
(when (> cnt 1) (error "Heading not unique on level %d: %s"
lmax heading))
(goto-char found)
(setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0)))
(setq end (save-excursion (org-end-of-subtree t t))))
(when (org-on-heading-p)
(move-marker (make-marker) (point))))))))
(defun org-mobile-locate-entry (link)
(if (string-match "\\`id:\\(.*\\)$" link)
(org-id-find (match-string 1 link) 'marker)
@ -1037,7 +1001,6 @@ be returned that indicates what went wrong."
t)
(t (error "Body was changed in MobileOrg and on the computer")))))))
(defun org-mobile-tags-same-p (list1 list2)
"Are the two tag lists the same?"
(not (or (org-delete-all list1 list2)

View File

@ -9675,9 +9675,10 @@ on the system \"/user@host:\"."
(defun org-get-outline-path (&optional fastp level heading)
"Return the outline path to the current entry, as a list.
The parameters FASTP, LEVEL, and HEADING are for use be a scanner
The parameters FASTP, LEVEL, and HEADING are for use by a scanner
routine which makes outline path derivations for an entire file,
avoiding backtracing."
avoiding backtracing. Refile target collection makes use of that."
(if fastp
(progn
(if (> level 19)
@ -13500,7 +13501,8 @@ in the current file."
"In the current entry, delete PROPERTY."
(interactive
(let* ((completion-ignore-case t)
(prop (org-icompleting-read "Property: " (org-entry-properties nil 'standard))))
(prop (org-icompleting-read "Property: "
(org-entry-properties nil 'standard))))
(list prop)))
(message "Property %s %s" property
(if (org-entry-delete nil property)
@ -13614,6 +13616,48 @@ completion."
(skip-chars-forward " \t")
(run-hook-with-args 'org-property-changed-functions key nval)))
(defun org-find-olp (path)
"Return a marker pointing to the entry at outline path OLP.
If anything goes wrong, throw an error.
You can wrap this call to cathc the error like this:
(condition-case msg
(org-mobile-locate-entry (match-string 4))
(error (nth 1 msg)))
The return value will then be either a string with the error message,
or a marker if everyhing is OK."
(let* ((file (pop path))
(buffer (find-file-noselect file))
(level 1)
(lmin 1)
(lmax 1)
limit re end found pos heading cnt)
(unless buffer (error "File not found :%s" file))
(with-current-buffer buffer
(save-excursion
(save-restriction
(widen)
(setq limit (point-max))
(goto-char (point-min))
(while (setq heading (pop path))
(setq re (format org-complex-heading-regexp-format
(regexp-quote heading)))
(setq cnt 0 pos (point))
(while (re-search-forward re end t)
(setq level (- (match-end 1) (match-beginning 1)))
(if (and (>= level lmin) (<= level lmax))
(setq found (match-beginning 0) cnt (1+ cnt))))
(when (= cnt 0) (error "Heading not found on level %d: %s"
lmax heading))
(when (> cnt 1) (error "Heading not unique on level %d: %s"
lmax heading))
(goto-char found)
(setq lmin (1+ level) lmax (+ lmin (if org-odd-levels-only 1 0)))
(setq end (save-excursion (org-end-of-subtree t t))))
(when (org-on-heading-p)
(move-marker (make-marker) (point))))))))
(defun org-find-entry-with-id (ident)
"Locate the entry that contains the ID property with exact value IDENT.
IDENT can be a string, a symbol or a number, this function will search for