summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2015-02-15 21:30:29 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2015-02-15 21:56:57 +0100
commit176681bc65b5c787dc0737ccd523afd19b7ea4c0 (patch)
tree0cf71eaecff62a83233a45f8c93ad98f0c20692d
parent13938b87c2f9b6b5d20787853368aeeed4c371b9 (diff)
downloadorg-mode-176681bc65b5c787dc0737ccd523afd19b7ea4c0.tar.gz
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.
-rw-r--r--lisp/org-footnote.el94
-rw-r--r--testing/lisp/test-org-footnote.el73
2 files changed, 135 insertions, 32 deletions
diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el
index 03034e9..79e5c38 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 be76119..5deafbc 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<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.