From cb42a48a308b80928cbdb42968e6ffad5eb5142d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 26 Apr 2013 16:14:29 +0200 Subject: [PATCH] Speed-up `org-insert-heading' * lisp/org.el (org-insert-heading): Refactor to use `org-in-item-p' only once. --- lisp/org.el | 317 ++++++++++++++++++++++++++-------------------------- 1 file changed, 159 insertions(+), 158 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 38b197b7a..2bb6127f7 100644 --- a/lisp/org.el +++ b/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.