Function: org-datetree--find-create-subheading
org-datetree--find-create-subheading is a byte-compiled function
defined in org-datetree.el.gz.
Signature
(org-datetree--find-create-subheading COMPARE-FUN NEW-TITLE LEVEL)
Documentation
Find datetree subheading, or create it if it doesn't exist.
After insertion, move point to beginning of the subheading, and narrow to its subtree. Returns non-nil if the heading was found, or nil if a new heading was created.
NEW-TITLE is the title of the subheading to be found or created. LEVEL is the level of the headline to be found or created. COMPARE-FUN is a function of 2 arguments for comparing headline titles; it should return a negative number if the first headline precedes the second, a positive number if the second number has precedence, 0 or t if the headlines are at the same time, and nil if a headline isn't a valid datetree subheading at this level.
Source Code
;; Defined in /usr/src/emacs/lisp/org/org-datetree.el.gz
(defun org-datetree--find-create-subheading
(compare-fun new-title level)
"Find datetree subheading, or create it if it doesn't exist.
After insertion, move point to beginning of the subheading, and
narrow to its subtree. Returns non-nil if the heading was found,
or nil if a new heading was created.
NEW-TITLE is the title of the subheading to be found or created.
LEVEL is the level of the headline to be found or created.
COMPARE-FUN is a function of 2 arguments for comparing headline
titles; it should return a negative number if the first headline
precedes the second, a positive number if the second number has
precedence, 0 or t if the headlines are at the same time, and nil
if a headline isn't a valid datetree subheading at this level."
(let* ((nstars (if org-odd-levels-only (1- (* 2 level)) level))
(heading-re (format "^\\*\\{%d\\}" nstars))
(sibling (car (org-element-cache-map
(lambda (d)
(when (= (org-element-property :level d) level)
(let ((compare-result
(funcall compare-fun
(org-element-property :raw-value d)
new-title)))
(and compare-result
(or (eq compare-result t) (>= compare-result 0))
d))))
:granularity 'headline
:restrict-elements '(headline)
:next-re heading-re
:fail-re heading-re
:narrow t
:limit-count 1))))
;; go to headline, or first successor sibling, or end of buffer
(if sibling
(goto-char (org-element-property :begin sibling))
(goto-char (point-max))
(unless (bolp) (insert "\n")))
(if (and sibling
(memq (funcall compare-fun
(org-element-property :raw-value sibling)
new-title)
'(0 t)))
;; narrow and return the matched headline
(progn
(org-narrow-to-subtree)
t)
;; insert new headline, narrow, and return it
(delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point))
(when (org--blank-before-heading-p) (insert "\n"))
(insert
(format "\n%s %s\n"
(make-string nstars ?*)
new-title))
(forward-line -1)
(org-narrow-to-subtree)
nil)))