diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index 03034e9e6..79e5c3870 100644 --- a/lisp/org-footnote.el +++ b/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) diff --git a/testing/lisp/test-org-footnote.el b/testing/lisp/test-org-footnote.el index be76119bc..5deafbc58 100644 --- a/testing/lisp/test-org-footnote.el +++ b/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" + (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" + (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" + (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 "Test" + (org-footnote-new))) + ;; Error at keywords. + (should-error + (org-test-with-temp-text "#+TITLE: value" + (org-footnote-new))) + (should-error + (org-test-with-temp-text "#+CAPTION: \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 " " + (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*" + (let ((org-footnote-auto-label t)) (org-footnote-new)) + (buffer-string)))) + (should-error + (org-test-with-temp-text " [[http://orgmode.org][Org mode]]" + (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 " + (let ((org-footnote-auto-label t)) (org-footnote-new)) + (buffer-string)))) + (should + (string-match-p + " \\*bold\\*\\[fn:1\\]" + (org-test-with-temp-text " *bold*" + (let ((org-footnote-auto-label t)) (org-footnote-new)) + (buffer-string))))) + (ert-deftest test-org-footnote/delete () "Test `org-footnote-delete' specifications." ;; Regular test.