Speed-up `org-insert-heading'
* lisp/org.el (org-insert-heading): Refactor to use `org-in-item-p' only once.
This commit is contained in:
Nicolas Goaziou
parent
3799de774e
commit
cb42a48a30
317
lisp/org.el
317
lisp/org.el
|
|
@ -7496,165 +7496,166 @@ When INVISIBLE-OK is set, stop at invisible headlines when going back.
|
||||||
This is important for non-interactive uses of the command."
|
This is important for non-interactive uses of the command."
|
||||||
(interactive "P")
|
(interactive "P")
|
||||||
(if (org-called-interactively-p 'any) (org-reveal))
|
(if (org-called-interactively-p 'any) (org-reveal))
|
||||||
(cond
|
(let ((itemp (org-in-item-p)))
|
||||||
((or (= (buffer-size) 0)
|
(cond
|
||||||
(and (not (save-excursion
|
((or (= (buffer-size) 0)
|
||||||
(and (ignore-errors (org-back-to-heading invisible-ok))
|
(and (not (save-excursion
|
||||||
(org-at-heading-p))))
|
(and (ignore-errors (org-back-to-heading invisible-ok))
|
||||||
(or arg (not (org-in-item-p)))))
|
(org-at-heading-p))))
|
||||||
(insert
|
(or arg (not itemp))))
|
||||||
(if (org-previous-line-empty-p) "" "\n")
|
(insert
|
||||||
(if (org-in-src-block-p) ",* " "* "))
|
(if (org-previous-line-empty-p) "" "\n")
|
||||||
(run-hooks 'org-insert-heading-hook))
|
(if (org-in-src-block-p) ",* " "* "))
|
||||||
((or arg
|
(run-hooks 'org-insert-heading-hook))
|
||||||
(and (not (org-in-item-p)) org-insert-heading-respect-content)
|
((or arg
|
||||||
(not (org-insert-item
|
(and (not itemp) org-insert-heading-respect-content)
|
||||||
(save-excursion
|
(not (org-insert-item
|
||||||
(and (org-in-item-p)
|
|
||||||
(org-beginning-of-item)
|
|
||||||
(looking-at org-list-full-item-re)
|
|
||||||
(match-string 3))))))
|
|
||||||
(let (begn endn)
|
|
||||||
(when (org-buffer-narrowed-p)
|
|
||||||
(setq begn (point-min) endn (point-max))
|
|
||||||
(widen))
|
|
||||||
(let* ((empty-line-p nil)
|
|
||||||
(eops (equal arg '(16))) ; insert at end of parent subtree
|
|
||||||
(org-insert-heading-respect-content
|
|
||||||
(or (not (null arg)) org-insert-heading-respect-content))
|
|
||||||
(level nil)
|
|
||||||
(on-heading (org-at-heading-p))
|
|
||||||
;; Get a level to fall back on
|
|
||||||
(fix-level
|
|
||||||
(save-excursion
|
|
||||||
(org-back-to-heading t)
|
|
||||||
(looking-at org-outline-regexp)
|
|
||||||
(make-string (1- (length (match-string 0))) ?*)))
|
|
||||||
(on-empty-line
|
|
||||||
(save-excursion (beginning-of-line 1) (looking-at "^\\s-*$")))
|
|
||||||
(head (save-excursion
|
|
||||||
(condition-case nil
|
|
||||||
(progn
|
|
||||||
(org-back-to-heading invisible-ok)
|
|
||||||
(when (and (not on-heading)
|
|
||||||
(featurep 'org-inlinetask)
|
|
||||||
(integerp org-inlinetask-min-level)
|
|
||||||
(>= (length (match-string 0))
|
|
||||||
org-inlinetask-min-level))
|
|
||||||
;; Find a heading level before the inline task
|
|
||||||
(while (and (setq level (org-up-heading-safe))
|
|
||||||
(>= level org-inlinetask-min-level)))
|
|
||||||
(if (org-at-heading-p)
|
|
||||||
(org-back-to-heading invisible-ok)
|
|
||||||
(error "This should not happen")))
|
|
||||||
(unless (and (save-excursion
|
|
||||||
(save-match-data
|
|
||||||
(org-backward-heading-same-level 1 invisible-ok))
|
|
||||||
(= (point) (match-beginning 0)))
|
|
||||||
(not (org-previous-line-empty-p t)))
|
|
||||||
(setq empty-line-p (org-previous-line-empty-p)))
|
|
||||||
(match-string 0))
|
|
||||||
(error (or fix-level "* ")))))
|
|
||||||
(blank-a (cdr (assq 'heading org-blank-before-new-entry)))
|
|
||||||
(blank (if (eq blank-a 'auto) empty-line-p blank-a))
|
|
||||||
pos hide-previous previous-pos)
|
|
||||||
(if ;; At the beginning of a heading, open a new line for insertion
|
|
||||||
(and (bolp) (org-at-heading-p)
|
|
||||||
(not eops)
|
|
||||||
(or (bobp)
|
|
||||||
(save-excursion (backward-char 1) (not (outline-invisible-p)))))
|
|
||||||
(open-line (if blank 2 1))
|
|
||||||
(save-excursion
|
|
||||||
(setq previous-pos (point-at-bol))
|
|
||||||
(end-of-line)
|
|
||||||
(setq hide-previous (outline-invisible-p)))
|
|
||||||
(and org-insert-heading-respect-content
|
|
||||||
(save-excursion
|
|
||||||
(while (outline-invisible-p)
|
|
||||||
(org-show-subtree)
|
|
||||||
(org-up-heading-safe))))
|
|
||||||
(let ((split
|
|
||||||
(and (org-get-alist-option org-M-RET-may-split-line 'headline)
|
|
||||||
(save-excursion
|
|
||||||
(let ((p (point)))
|
|
||||||
(goto-char (point-at-bol))
|
|
||||||
(and (looking-at org-complex-heading-regexp)
|
|
||||||
(match-beginning 4)
|
|
||||||
(> p (match-beginning 4)))))))
|
|
||||||
tags pos)
|
|
||||||
(cond
|
|
||||||
;; Insert a new line, possibly at end of parent subtree
|
|
||||||
((and (not arg) (not on-heading) (not on-empty-line)
|
|
||||||
(not (save-excursion
|
|
||||||
(beginning-of-line 1)
|
|
||||||
(or (looking-at org-list-full-item-re)
|
|
||||||
;; Don't convert :end: lines to headline
|
|
||||||
(looking-at "^\\s-*:end:")
|
|
||||||
(looking-at "^\\s-*#\\+end_?")))))
|
|
||||||
(beginning-of-line 1))
|
|
||||||
(org-insert-heading-respect-content
|
|
||||||
(if (not eops)
|
|
||||||
(progn
|
|
||||||
(org-end-of-subtree nil t)
|
|
||||||
(and (looking-at "^\\*") (backward-char 1))
|
|
||||||
(while (and (not (bobp))
|
|
||||||
;; Don't delete spaces in empty headlines
|
|
||||||
(not (looking-back org-outline-regexp))
|
|
||||||
(member (char-before) '(?\ ?\t ?\n)))
|
|
||||||
(backward-delete-char 1)))
|
|
||||||
(let ((p (point)))
|
|
||||||
(org-up-heading-safe)
|
|
||||||
(if (= p (point))
|
|
||||||
(goto-char (point-max))
|
|
||||||
(org-end-of-subtree nil t))))
|
|
||||||
(when (featurep 'org-inlinetask)
|
|
||||||
(while (and (not (eobp))
|
|
||||||
(looking-at "\\(\\*+\\)[ \t]+")
|
|
||||||
(>= (length (match-string 1))
|
|
||||||
org-inlinetask-min-level))
|
|
||||||
(org-end-of-subtree nil t)))
|
|
||||||
(or (bolp) (newline))
|
|
||||||
(or (org-previous-line-empty-p)
|
|
||||||
(and blank (newline)))
|
|
||||||
(if (or empty-line-p eops) (open-line 1)))
|
|
||||||
;; Insert a headling containing text after point
|
|
||||||
((org-at-heading-p)
|
|
||||||
(when hide-previous
|
|
||||||
(show-children)
|
|
||||||
(org-show-entry))
|
|
||||||
(looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
|
|
||||||
(setq tags (and (match-end 2) (match-string 2)))
|
|
||||||
(and (match-end 1)
|
|
||||||
(delete-region (match-beginning 1) (match-end 1)))
|
|
||||||
(setq pos (point-at-bol))
|
|
||||||
(or split (end-of-line 1))
|
|
||||||
(delete-horizontal-space)
|
|
||||||
(if (string-match "\\`\\*+\\'"
|
|
||||||
(buffer-substring (point-at-bol) (point)))
|
|
||||||
(insert " "))
|
|
||||||
(newline (if blank 2 1))
|
|
||||||
(when tags
|
|
||||||
(save-excursion
|
(save-excursion
|
||||||
(goto-char pos)
|
(and itemp
|
||||||
(end-of-line 1)
|
(goto-char itemp)
|
||||||
(insert " " tags)
|
(looking-at org-list-full-item-re)
|
||||||
(org-set-tags nil 'align))))
|
(match-string 3))))))
|
||||||
(t
|
(let (begn endn)
|
||||||
(or split (end-of-line 1))
|
(when (org-buffer-narrowed-p)
|
||||||
(newline (cond ((and blank (not on-empty-line)) 2)
|
(setq begn (point-min) endn (point-max))
|
||||||
(blank 1)
|
(widen))
|
||||||
(on-empty-line 0) (t 1)))))))
|
(let* ((empty-line-p nil)
|
||||||
(insert head) (just-one-space)
|
(eops (equal arg '(16))) ; insert at end of parent subtree
|
||||||
(setq pos (point))
|
(org-insert-heading-respect-content
|
||||||
(end-of-line 1)
|
(or (not (null arg)) org-insert-heading-respect-content))
|
||||||
(unless (= (point) pos) (just-one-space) (backward-delete-char 1))
|
(level nil)
|
||||||
(when (and org-insert-heading-respect-content hide-previous)
|
(on-heading (org-at-heading-p))
|
||||||
(save-excursion
|
;; Get a level to fall back on
|
||||||
(goto-char previous-pos)
|
(fix-level
|
||||||
(hide-subtree)))
|
(save-excursion
|
||||||
(when (and begn endn)
|
(org-back-to-heading t)
|
||||||
(narrow-to-region (min (point) begn) (max (point) endn)))
|
(looking-at org-outline-regexp)
|
||||||
(run-hooks 'org-insert-heading-hook))))))
|
(make-string (1- (length (match-string 0))) ?*)))
|
||||||
|
(on-empty-line
|
||||||
|
(save-excursion (beginning-of-line 1) (looking-at "^\\s-*$")))
|
||||||
|
(head (save-excursion
|
||||||
|
(condition-case nil
|
||||||
|
(progn
|
||||||
|
(org-back-to-heading invisible-ok)
|
||||||
|
(when (and (not on-heading)
|
||||||
|
(featurep 'org-inlinetask)
|
||||||
|
(integerp org-inlinetask-min-level)
|
||||||
|
(>= (length (match-string 0))
|
||||||
|
org-inlinetask-min-level))
|
||||||
|
;; Find a heading level before the inline task
|
||||||
|
(while (and (setq level (org-up-heading-safe))
|
||||||
|
(>= level org-inlinetask-min-level)))
|
||||||
|
(if (org-at-heading-p)
|
||||||
|
(org-back-to-heading invisible-ok)
|
||||||
|
(error "This should not happen")))
|
||||||
|
(unless (and (save-excursion
|
||||||
|
(save-match-data
|
||||||
|
(org-backward-heading-same-level 1 invisible-ok))
|
||||||
|
(= (point) (match-beginning 0)))
|
||||||
|
(not (org-previous-line-empty-p t)))
|
||||||
|
(setq empty-line-p (org-previous-line-empty-p)))
|
||||||
|
(match-string 0))
|
||||||
|
(error (or fix-level "* ")))))
|
||||||
|
(blank-a (cdr (assq 'heading org-blank-before-new-entry)))
|
||||||
|
(blank (if (eq blank-a 'auto) empty-line-p blank-a))
|
||||||
|
pos hide-previous previous-pos)
|
||||||
|
(if ;; At the beginning of a heading, open a new line for insertion
|
||||||
|
(and (bolp) (org-at-heading-p)
|
||||||
|
(not eops)
|
||||||
|
(or (bobp)
|
||||||
|
(save-excursion (backward-char 1) (not (outline-invisible-p)))))
|
||||||
|
(open-line (if blank 2 1))
|
||||||
|
(save-excursion
|
||||||
|
(setq previous-pos (point-at-bol))
|
||||||
|
(end-of-line)
|
||||||
|
(setq hide-previous (outline-invisible-p)))
|
||||||
|
(and org-insert-heading-respect-content
|
||||||
|
(save-excursion
|
||||||
|
(while (outline-invisible-p)
|
||||||
|
(org-show-subtree)
|
||||||
|
(org-up-heading-safe))))
|
||||||
|
(let ((split
|
||||||
|
(and (org-get-alist-option org-M-RET-may-split-line 'headline)
|
||||||
|
(save-excursion
|
||||||
|
(let ((p (point)))
|
||||||
|
(goto-char (point-at-bol))
|
||||||
|
(and (looking-at org-complex-heading-regexp)
|
||||||
|
(match-beginning 4)
|
||||||
|
(> p (match-beginning 4)))))))
|
||||||
|
tags pos)
|
||||||
|
(cond
|
||||||
|
;; Insert a new line, possibly at end of parent subtree
|
||||||
|
((and (not arg) (not on-heading) (not on-empty-line)
|
||||||
|
(not (save-excursion
|
||||||
|
(beginning-of-line 1)
|
||||||
|
(or (looking-at org-list-full-item-re)
|
||||||
|
;; Don't convert :end: lines to headline
|
||||||
|
(looking-at "^\\s-*:end:")
|
||||||
|
(looking-at "^\\s-*#\\+end_?")))))
|
||||||
|
(beginning-of-line 1))
|
||||||
|
(org-insert-heading-respect-content
|
||||||
|
(if (not eops)
|
||||||
|
(progn
|
||||||
|
(org-end-of-subtree nil t)
|
||||||
|
(and (looking-at "^\\*") (backward-char 1))
|
||||||
|
(while (and (not (bobp))
|
||||||
|
;; Don't delete spaces in empty headlines
|
||||||
|
(not (looking-back org-outline-regexp))
|
||||||
|
(member (char-before) '(?\ ?\t ?\n)))
|
||||||
|
(backward-delete-char 1)))
|
||||||
|
(let ((p (point)))
|
||||||
|
(org-up-heading-safe)
|
||||||
|
(if (= p (point))
|
||||||
|
(goto-char (point-max))
|
||||||
|
(org-end-of-subtree nil t))))
|
||||||
|
(when (featurep 'org-inlinetask)
|
||||||
|
(while (and (not (eobp))
|
||||||
|
(looking-at "\\(\\*+\\)[ \t]+")
|
||||||
|
(>= (length (match-string 1))
|
||||||
|
org-inlinetask-min-level))
|
||||||
|
(org-end-of-subtree nil t)))
|
||||||
|
(or (bolp) (newline))
|
||||||
|
(or (org-previous-line-empty-p)
|
||||||
|
(and blank (newline)))
|
||||||
|
(if (or empty-line-p eops) (open-line 1)))
|
||||||
|
;; Insert a headling containing text after point
|
||||||
|
((org-at-heading-p)
|
||||||
|
(when hide-previous
|
||||||
|
(show-children)
|
||||||
|
(org-show-entry))
|
||||||
|
(looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
|
||||||
|
(setq tags (and (match-end 2) (match-string 2)))
|
||||||
|
(and (match-end 1)
|
||||||
|
(delete-region (match-beginning 1) (match-end 1)))
|
||||||
|
(setq pos (point-at-bol))
|
||||||
|
(or split (end-of-line 1))
|
||||||
|
(delete-horizontal-space)
|
||||||
|
(if (string-match "\\`\\*+\\'"
|
||||||
|
(buffer-substring (point-at-bol) (point)))
|
||||||
|
(insert " "))
|
||||||
|
(newline (if blank 2 1))
|
||||||
|
(when tags
|
||||||
|
(save-excursion
|
||||||
|
(goto-char pos)
|
||||||
|
(end-of-line 1)
|
||||||
|
(insert " " tags)
|
||||||
|
(org-set-tags nil 'align))))
|
||||||
|
(t
|
||||||
|
(or split (end-of-line 1))
|
||||||
|
(newline (cond ((and blank (not on-empty-line)) 2)
|
||||||
|
(blank 1)
|
||||||
|
(on-empty-line 0) (t 1)))))))
|
||||||
|
(insert head) (just-one-space)
|
||||||
|
(setq pos (point))
|
||||||
|
(end-of-line 1)
|
||||||
|
(unless (= (point) pos) (just-one-space) (backward-delete-char 1))
|
||||||
|
(when (and org-insert-heading-respect-content hide-previous)
|
||||||
|
(save-excursion
|
||||||
|
(goto-char previous-pos)
|
||||||
|
(hide-subtree)))
|
||||||
|
(when (and begn endn)
|
||||||
|
(narrow-to-region (min (point) begn) (max (point) endn)))
|
||||||
|
(run-hooks 'org-insert-heading-hook)))))))
|
||||||
|
|
||||||
(defun org-get-heading (&optional no-tags no-todo)
|
(defun org-get-heading (&optional no-tags no-todo)
|
||||||
"Return the heading of the current entry, without the stars.
|
"Return the heading of the current entry, without the stars.
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue