org-list: slight speed-up for org-list-context

1 files changed, 57 insertions, 66 deletions

diff --git a/lisp/org-list.el b/lisp/org-list.el
index b42a5e1..2ddc496 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -517,73 +517,64 @@ are boundaries and CONTEXT is a symbol among `drawer', `block',
 Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'."
   (save-match-data
     (save-excursion
-      (beginning-of-line)
-      (let* ((case-fold-search t) (pos (point)) beg end
-	     ;; Compute position of surrounding headings. This is the
+      (org-with-limited-levels
+       (beginning-of-line)
+       (let ((case-fold-search t) (pos (point)) beg end context-type
+	     ;; Get positions of surrounding headings. This is the
 	     ;; default context.
-	     (heading
-	      (org-with-limited-levels
-	       (save-excursion
-		 (list (or (and (org-at-heading-p) (point-at-bol))
-			   (outline-previous-heading)
-			   (point-min))
-		       (or (outline-next-heading) (point-max))
-		       nil))))
-	     (prev-head (car heading))
-	     (next-head (nth 1 heading))
-	     ;; Is point inside a drawer?
-	     (drawerp
-	      (save-excursion
-		(let ((end-re "^[ \t]*:END:")
-		      ;; Can't use org-drawers-regexp as this function
-		      ;; might be called in buffers not in Org mode
-		      (drawers-re (concat "^[ \t]*:\\("
-					  (mapconcat 'regexp-quote org-drawers "\\|")
-					  "\\):[ \t]*$")))
-		  (and (not (looking-at drawers-re))
-		       (not (looking-at end-re))
-		       (setq beg (and (re-search-backward drawers-re prev-head t)
-				      (1+ (point-at-eol))))
-		       (setq end (or (and (re-search-forward end-re next-head t)
-					  (1- (match-beginning 0)))
-				     next-head))
-		       (>= end pos)
-		       (list beg end 'drawer)))))
-	     ;; Is point strictly in a block, and of which type?
-	     (blockp
-	      (save-excursion
-		(let ((block-re "^[ \t]*#\\+\\(begin\\|end\\)_") type)
-		  (and (not (looking-at block-re))
-		       (setq beg (and (re-search-backward block-re prev-head t)
-				      (1+ (point-at-eol))))
-		       (looking-at "^[ \t]*#\\+begin_\\(\\S-+\\)")
-		       (setq type (downcase (match-string 1)))
-		       (goto-char beg)
-		       (setq end (or (and (re-search-forward block-re next-head t)
-					  (1- (point-at-bol)))
-				     next-head))
-		       (>= end pos)
-		       (equal (downcase (match-string 1)) "end")
-		       (list beg end (if (member type org-list-forbidden-blocks)
-					 'invalid 'block))))))
-	     ;; Is point in an inlinetask?
-	     (inlinetaskp
-	      (when (featurep 'org-inlinetask)
-		(save-excursion
-		  (let* ((stars-re (org-inlinetask-outline-regexp))
-			 (end-re (concat stars-re "END[ \t]*$")))
-		    (and (not (looking-at "^\\*+"))
-			 (setq beg (and (re-search-backward stars-re prev-head t)
-					(1+ (point-at-eol))))
-			 (not (looking-at end-re))
-			 (setq end (and (re-search-forward end-re next-head t)
-					(1- (match-beginning 0))))
-			 (> (point) pos)
-			 (list beg end 'inlinetask))))))
-	     ;; List actual candidates
-	     (context-list (delq nil (list heading drawerp blockp inlinetaskp))))
-	;; Return the closest context around
-	(assq (apply 'max (mapcar 'car context-list)) context-list)))))
+	     (lim-up (or (save-excursion (and (ignore-errors (org-back-to-heading t))
+					      (point)))
+			 (point-min)))
+	     (lim-down (or (save-excursion (outline-next-heading)) (point-max))))
+	 ;; Is point inside a drawer?
+	 (let ((end-re "^[ \t]*:END:")
+	       ;; Can't use org-drawers-regexp as this function
+	       ;; might be called in buffers not in Org mode
+	       (beg-re (concat "^[ \t]*:\\("
+			       (mapconcat 'regexp-quote org-drawers "\\|")
+			       "\\):[ \t]*$")))
+	   (when (save-excursion
+		   (and (not (looking-at beg-re))
+			(not (looking-at end-re))
+			(setq beg (and (re-search-backward beg-re lim-up t)
+				       (1+ (point-at-eol))))
+			(setq end (or (and (re-search-forward end-re lim-down t)
+					   (1- (match-beginning 0)))
+				      lim-down))
+			(>= end pos)))
+	     (setq lim-up beg lim-down end context-type 'drawer)))
+	 ;; Is point strictly in a block, and of which type?
+	 (let ((block-re "^[ \t]*#\\+\\(begin\\|end\\)_") type)
+	   (when (save-excursion
+		   (and (not (looking-at block-re))
+			(setq beg (and (re-search-backward block-re lim-up t)
+				       (1+ (point-at-eol))))
+			(looking-at "^[ \t]*#\\+begin_\\(\\S-+\\)")
+			(setq type (downcase (match-string 1)))
+			(goto-char beg)
+			(setq end (or (and (re-search-forward block-re lim-down t)
+					   (1- (point-at-bol)))
+				      lim-down))
+			(>= end pos)
+			(equal (downcase (match-string 1)) "end")))
+	     (setq lim-up beg lim-down end
+		   context-type (if (member type org-list-forbidden-blocks)
+				    'invalid 'block))))
+	 ;; Is point in an inlinetask?
+	 (when (and (featurep 'org-inlinetask)
+		    (save-excursion
+		      (let* ((beg-re (org-inlinetask-outline-regexp))
+			     (end-re (concat beg-re "END[ \t]*$")))
+			(and (not (looking-at "^\\*+"))
+			     (setq beg (and (re-search-backward beg-re lim-up t)
+					    (1+ (point-at-eol))))
+			     (not (looking-at end-re))
+			     (setq end (and (re-search-forward end-re lim-down t)
+					    (1- (match-beginning 0))))
+			     (> (point) pos)))))
+	   (setq lim-up beg lim-down end context-type 'inlinetask))
+	 ;; Return context boundaries and type.
+	 (list lim-up lim-down context-type))))))
 
 (defun org-list-struct ()
   "Return structure of list at point.