forked from mirrors/org-mode
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."
|
||||
(interactive "P")
|
||||
(if (org-called-interactively-p 'any) (org-reveal))
|
||||
(cond
|
||||
((or (= (buffer-size) 0)
|
||||
(and (not (save-excursion
|
||||
(and (ignore-errors (org-back-to-heading invisible-ok))
|
||||
(org-at-heading-p))))
|
||||
(or arg (not (org-in-item-p)))))
|
||||
(insert
|
||||
(if (org-previous-line-empty-p) "" "\n")
|
||||
(if (org-in-src-block-p) ",* " "* "))
|
||||
(run-hooks 'org-insert-heading-hook))
|
||||
((or arg
|
||||
(and (not (org-in-item-p)) org-insert-heading-respect-content)
|
||||
(not (org-insert-item
|
||||
(save-excursion
|
||||
(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
|
||||
(let ((itemp (org-in-item-p)))
|
||||
(cond
|
||||
((or (= (buffer-size) 0)
|
||||
(and (not (save-excursion
|
||||
(and (ignore-errors (org-back-to-heading invisible-ok))
|
||||
(org-at-heading-p))))
|
||||
(or arg (not itemp))))
|
||||
(insert
|
||||
(if (org-previous-line-empty-p) "" "\n")
|
||||
(if (org-in-src-block-p) ",* " "* "))
|
||||
(run-hooks 'org-insert-heading-hook))
|
||||
((or arg
|
||||
(and (not itemp) org-insert-heading-respect-content)
|
||||
(not (org-insert-item
|
||||
(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))))))
|
||||
(and itemp
|
||||
(goto-char itemp)
|
||||
(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
|
||||
(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)
|
||||
"Return the heading of the current entry, without the stars.
|
||||
|
|
|
|||
Loading…
Reference in New Issue