org-footnote: Be more strict about location for new footnotes

* lisp/org-footnote.el (org-footnote--allow-reference-p): New
  function.
(org-footnote-new): Use new function.

* testing/lisp/test-org-footnote.el (test-org-footnote/new): New test.

In particular, Org now refuses to add a footnote reference in
a keyword, e.g., TITLE.

lisp/org-footnote.el

@@ -447,46 +447,76 @@ buffer."
       (incf cnt))
     (format fmt cnt)))
 
+(defun org-footnote--allow-reference-p ()
+  "Non-nil when a footnote reference can be inserted at point."
+  ;; XXX: This is similar to `org-footnote-in-valid-context-p' but
+  ;; more accurate and usually faster, except in some corner cases.
+  ;; It may replace it after doing proper benchmarks as it would be
+  ;; used in fontification.
+  (unless (bolp)
+    (let* ((context (org-element-context))
+	   (type (org-element-type context)))
+      (cond
+       ;; No footnote reference in attributes.
+       ((let ((post (org-element-property :post-affiliated context)))
+	  (and post (< (point) post)))
+	nil)
+       ;; Paragraphs and blank lines at top of document are fine.
+       ((memq type '(nil paragraph)))
+       ;; So are contents of verse blocks.
+       ((eq type 'verse-block)
+	(and (>= (point) (org-element-property :contents-begin context))
+	     (< (point) (org-element-property :contents-end context))))
+       ;; White spaces after an object or blank lines after an element
+       ;; are OK.
+       ((>= (point)
+	    (save-excursion (goto-char (org-element-property :end context))
+			    (skip-chars-backward " \r\t\n")
+			    (if (memq type org-element-all-objects) (point)
+			      (1+ (line-beginning-position 2))))))
+       ;; Other elements are invalid.
+       ((memq type org-element-all-elements) nil)
+       ;; Just before object is fine.
+       ((= (point) (org-element-property :begin context)))
+       ;; Within recursive object too, but not in a link.
+       ((eq type 'link) nil)
+       ((let ((cbeg (org-element-property :contents-begin context))
+	      (cend (org-element-property :contents-end context)))
+	  (and cbeg (>= (point) cbeg) (<= (point) cend))))))))
+
 (defun org-footnote-new ()
   "Insert a new footnote.
 This command prompts for a label.  If this is a label referencing an
 existing label, only insert the label.  If the footnote label is empty
 or new, let the user edit the definition of the footnote."
   (interactive)
-  (unless (org-footnote-in-valid-context-p)
-    (error "Cannot insert a footnote here"))
-  (let* ((lbls (and (not (equal org-footnote-auto-label 'random))
-		    (org-footnote-all-labels)))
-	 (propose (and (not (equal org-footnote-auto-label 'random))
-		       (org-footnote-unique-label lbls)))
+  (unless (org-footnote--allow-reference-p)
+    (user-error "Cannot insert a footnote here"))
+  (let* ((all (org-footnote-all-labels))
 	 (label
 	  (org-footnote-normalize-label
-	   (cond
-	    ((member org-footnote-auto-label '(t plain))
-	     propose)
-	    ((equal org-footnote-auto-label 'random)
-	     (format "fn:%x" (random #x100000000)))
-	    (t
-	     (org-icompleting-read
-	      "Label (leave empty for anonymous): "
-	      (mapcar 'list lbls) nil nil
-	      (if (eq org-footnote-auto-label 'confirm) propose nil)))))))
-    (cond
-     ((bolp) (error "Cannot create a footnote reference at left margin"))
-     ((not label)
-      (insert "[fn:: ]")
-      (backward-char 1))
-     ((member label lbls)
-      (insert "[" label "]")
-      (message "New reference to existing note"))
-     (org-footnote-define-inline
-      (insert "[" label ": ]")
-      (backward-char 1)
-      (org-footnote-auto-adjust-maybe))
-     (t
-      (insert "[" label "]")
-      (org-footnote-create-definition label)
-      (org-footnote-auto-adjust-maybe)))))
+	   (if (eq org-footnote-auto-label 'random)
+	       (format "fn:%x" (random #x100000000))
+	     (let ((propose (org-footnote-unique-label all)))
+	       (if (memq org-footnote-auto-label '(t plain)) propose
+		 (org-icompleting-read
+		  "Label (leave empty for anonymous): "
+		  (mapcar #'list all) nil nil
+		  (and (eq org-footnote-auto-label 'confirm) propose))))))))
+    (cond ((not label)
+	   (insert "[fn:: ]")
+	   (backward-char 1))
+	  ((member label all)
+	   (insert "[" label "]")
+	   (message "New reference to existing note"))
+	  (org-footnote-define-inline
+	   (insert "[" label ": ]")
+	   (backward-char 1)
+	   (org-footnote-auto-adjust-maybe))
+	  (t
+	   (insert "[" label "]")
+	   (org-footnote-create-definition label)
+	   (org-footnote-auto-adjust-maybe)))))
 
 (defvar org-blank-before-new-entry) ; silence byte-compiler
 (defun org-footnote-create-definition (label)

testing/lisp/test-org-footnote.el

@@ -19,6 +19,79 @@
 
 ;;; Code:
 
+(ert-deftest test-org-footnote/new ()
+  "Test `org-footnote-new' specifications."
+  ;; `org-footnote-auto-label' is t.
+  (should
+   (string-match-p
+    "Test\\[fn:1\\]\n+\\[fn:1\\]"
+    (org-test-with-temp-text "Test<point>"
+      (let ((org-footnote-auto-label t)
+	    (org-footnote-section nil))
+	(org-footnote-new))
+      (buffer-string))))
+  ;; `org-footnote-auto-label' is `plain'.
+  (should
+   (string-match-p
+    "Test\\[1\\]\n+\\[1\\]"
+    (org-test-with-temp-text "Test<point>"
+      (let ((org-footnote-auto-label 'plain)
+	    (org-footnote-section nil))
+	(org-footnote-new))
+      (buffer-string))))
+  ;; `org-footnote-auto-label' is `random'.
+  (should
+   (string-match-p
+    "Test\\[fn:\\(.+?\\)\\]\n+\\[fn:\\1\\]"
+    (org-test-with-temp-text "Test<point>"
+      (let ((org-footnote-auto-label 'random)
+	    (org-footnote-section nil))
+	(org-footnote-new))
+      (buffer-string))))
+  ;; Error at beginning of line.
+  (should-error
+   (org-test-with-temp-text "<point>Test"
+     (org-footnote-new)))
+  ;; Error at keywords.
+  (should-error
+   (org-test-with-temp-text "#+TIT<point>LE: value"
+     (org-footnote-new)))
+  (should-error
+   (org-test-with-temp-text "#+CAPTION: <point>\nParagraph"
+     (org-footnote-new)))
+  ;; Allow new footnotes in blank lines at the beginning of the
+  ;; document.
+  (should
+   (string-match-p
+    " \\[fn:1\\]"
+    (org-test-with-temp-text " <point>"
+      (let ((org-footnote-auto-label t)) (org-footnote-new))
+      (buffer-string))))
+  ;; Allow new footnotes within recursive objects, but not in links.
+  (should
+   (string-match-p
+    " \\*bold\\[fn:1\\]\\*"
+    (org-test-with-temp-text " *bold<point>*"
+      (let ((org-footnote-auto-label t)) (org-footnote-new))
+      (buffer-string))))
+  (should-error
+   (org-test-with-temp-text " [[http://orgmode.org][Org mode<point>]]"
+     (org-footnote-new)))
+  ;; Allow new footnotes in blank lines after an element or white
+  ;; spaces after an object.
+  (should
+   (string-match-p
+    " \\[fn:1\\]"
+    (org-test-with-temp-text "#+BEGIN_EXAMPLE\nA\n#+END_EXAMPLE\n <point>"
+      (let ((org-footnote-auto-label t)) (org-footnote-new))
+      (buffer-string))))
+  (should
+   (string-match-p
+    " \\*bold\\*\\[fn:1\\]"
+    (org-test-with-temp-text " *bold*<point>"
+      (let ((org-footnote-auto-label t)) (org-footnote-new))
+      (buffer-string)))))
+
 (ert-deftest test-org-footnote/delete ()
   "Test `org-footnote-delete' specifications."
   ;; Regular test.