aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-05-02 10:27:42 -0400
committerStefan Monnier2019-05-02 10:27:42 -0400
commit3fa9c9f774277530f4dac6c4f5de157cb4cdc536 (patch)
tree85d264dd468711f50172ed9d38dafddde97bdc11
parente10e314e2b7583d892e86cee92ec57d3a1030ce4 (diff)
downloademacs-3fa9c9f774277530f4dac6c4f5de157cb4cdc536.tar.gz
emacs-3fa9c9f774277530f4dac6c4f5de157cb4cdc536.zip
* lisp/mail/footnote.el: Tweak markers convention
Instead of using markers that are sometimes before and sometimes after the [...] and using `insert-before-markers` to make sure those that are are before stay before, always place them before, and make them "move after"so they stay with their [...] without the need for insert-before-markers. (footnote--current-regexp): Add arg to match previous style. Include the start/end "tags" in the regexp. Adjust all callers. (footnote--markers-alist): Change position of POINTERS. (footnote--refresh-footnotes, footnote--renumber) (footnote--make-hole, footnote-delete-footnote) (footnote-back-to-message): Adjust accordingly, mostly by using `looking-at` instead of `looking-back`. (footnote--make-hole): Always return footnote nb to use. (footnote-add-footnote): Simplify call accordingly. * test/lisp/mail/footnote-tests.el: New file.
-rw-r--r--lisp/mail/footnote.el92
-rw-r--r--test/lisp/mail/footnote-tests.el47
2 files changed, 84 insertions, 55 deletions
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 9a918376e67..d985444a8e1 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -165,8 +165,7 @@ left with the first character of footnote text."
165Where FN is the footnote number, TEXT is a marker pointing to 165Where FN is the footnote number, TEXT is a marker pointing to
166the footnote's text, and POINTERS is a list of markers pointing 166the footnote's text, and POINTERS is a list of markers pointing
167to the places from which the footnote is referenced. 167to the places from which the footnote is referenced.
168TEXT points right *before* the [...] and POINTERS point right 168Both TEXT and POINTERS points right *before* the [...]")
169*after* the [...].")
170 169
171(defvar footnote-mouse-highlight 'highlight 170(defvar footnote-mouse-highlight 'highlight
172 ;; FIXME: This `highlight' property is not currently used. 171 ;; FIXME: This `highlight' property is not currently used.
@@ -436,30 +435,26 @@ Conversion is done based upon the current selected style."
436 (nth 0 footnote-style-alist)))) 435 (nth 0 footnote-style-alist))))
437 (funcall (nth 1 alist) index))) 436 (funcall (nth 1 alist) index)))
438 437
439(defun footnote--current-regexp () 438(defun footnote--current-regexp (&optional index-regexp)
440 "Return the regexp of the index of the current style." 439 "Return the regexp of the index of the current style."
441 (let ((regexp (nth 2 (or (assq footnote-style footnote-style-alist) 440 (let ((regexp (or index-regexp
442 (nth 0 footnote-style-alist))))) 441 (nth 2 (or (assq footnote-style footnote-style-alist)
442 (nth 0 footnote-style-alist))))))
443 (concat 443 (concat
444 (regexp-quote footnote-start-tag) "\\("
444 ;; Hack to avoid repetition of repetition. 445 ;; Hack to avoid repetition of repetition.
445 ;; FIXME: I'm not sure the added * makes sense at all; there is 446 ;; FIXME: I'm not sure the added * makes sense at all; there is
446 ;; always a single number within the footnote-{start,end}-tag pairs. 447 ;; always a single number within the footnote-{start,end}-tag pairs.
447 ;; Worse, the code goes on and adds yet another + later on, in
448 ;; footnote-refresh-footnotes, just in case. That makes even less sense.
449 ;; Likely, both the * and the extra + should go away.
450 (if (string-match "[^\\]\\\\\\{2\\}*[*+?]\\'" regexp) 448 (if (string-match "[^\\]\\\\\\{2\\}*[*+?]\\'" regexp)
451 (substring regexp 0 -1) 449 (substring regexp 0 -1)
452 regexp) 450 regexp)
453 "*"))) 451 "*\\)" (regexp-quote footnote-end-tag))))
454 452
455(defun footnote--refresh-footnotes (&optional index-regexp) 453(defun footnote--refresh-footnotes (&optional index-regexp)
456 "Redraw all footnotes. 454 "Redraw all footnotes.
457You must call this or arrange to have this called after changing 455You must call this or arrange to have this called after changing
458footnote styles." 456footnote styles."
459 (let ((fn-regexp (concat 457 (let ((fn-regexp (footnote--current-regexp index-regexp)))
460 (regexp-quote footnote-start-tag)
461 "\\(" (or index-regexp (footnote--current-regexp)) "+\\)"
462 (regexp-quote footnote-end-tag))))
463 (save-excursion 458 (save-excursion
464 (pcase-dolist (`(,fn ,text . ,pointers) footnote--markers-alist) 459 (pcase-dolist (`(,fn ,text . ,pointers) footnote--markers-alist)
465 ;; Take care of the pointers first 460 ;; Take care of the pointers first
@@ -467,8 +462,7 @@ footnote styles."
467 (goto-char locn) 462 (goto-char locn)
468 ;; Try to handle the case where `footnote-start-tag' and 463 ;; Try to handle the case where `footnote-start-tag' and
469 ;; `footnote-end-tag' are the same string. 464 ;; `footnote-end-tag' are the same string.
470 (when (looking-back fn-regexp 465 (when (looking-at fn-regexp)
471 (line-beginning-position))
472 (replace-match 466 (replace-match
473 (propertize 467 (propertize
474 (concat 468 (concat
@@ -515,7 +509,7 @@ footnote styles."
515 (let ((string (concat footnote-start-tag 509 (let ((string (concat footnote-start-tag
516 (footnote--index-to-string arg) 510 (footnote--index-to-string arg)
517 footnote-end-tag))) 511 footnote-end-tag)))
518 (insert-before-markers 512 (insert
519 (if mousable 513 (if mousable
520 (propertize 514 (propertize
521 string 'footnote-number arg footnote-mouse-highlight t) 515 string 'footnote-number arg footnote-mouse-highlight t)
@@ -524,13 +518,11 @@ footnote styles."
524(defun footnote--renumber (to alist-elem) 518(defun footnote--renumber (to alist-elem)
525 "Renumber a single footnote." 519 "Renumber a single footnote."
526 (unless (equal to (car alist-elem)) ;Nothing to do. 520 (unless (equal to (car alist-elem)) ;Nothing to do.
527 (let* ((fn-regexp (concat (regexp-quote footnote-start-tag) 521 (let* ((fn-regexp (footnote--current-regexp)))
528 (footnote--current-regexp)
529 (regexp-quote footnote-end-tag))))
530 (setcar alist-elem to) 522 (setcar alist-elem to)
531 (dolist (posn (cddr alist-elem)) 523 (dolist (posn (cddr alist-elem))
532 (goto-char posn) 524 (goto-char posn)
533 (when (looking-back fn-regexp (line-beginning-position)) 525 (when (looking-at fn-regexp)
534 (replace-match 526 (replace-match
535 (propertize 527 (propertize
536 (concat footnote-start-tag 528 (concat footnote-start-tag
@@ -562,7 +554,7 @@ footnote styles."
562 "Insert a marker pointing to footnote ARG, at buffer location LOCN." 554 "Insert a marker pointing to footnote ARG, at buffer location LOCN."
563 (let ((entry (assq arg footnote--markers-alist))) 555 (let ((entry (assq arg footnote--markers-alist)))
564 (unless (cadr entry) 556 (unless (cadr entry)
565 (let ((marker (copy-marker locn))) 557 (let ((marker (copy-marker locn t)))
566 (if entry 558 (if entry
567 (setf (cadr entry) marker) 559 (setf (cadr entry) marker)
568 (push `(,arg ,marker) footnote--markers-alist) 560 (push `(,arg ,marker) footnote--markers-alist)
@@ -572,7 +564,7 @@ footnote styles."
572(defun footnote--insert-pointer-marker (arg locn) 564(defun footnote--insert-pointer-marker (arg locn)
573 "Insert a marker pointing to footnote ARG, at buffer location LOCN." 565 "Insert a marker pointing to footnote ARG, at buffer location LOCN."
574 (let ((entry (assq arg footnote--markers-alist)) 566 (let ((entry (assq arg footnote--markers-alist))
575 (marker (copy-marker locn))) 567 (marker (copy-marker locn t)))
576 (if entry 568 (if entry
577 (push marker (cddr entry)) 569 (push marker (cddr entry))
578 (push `(,arg nil ,marker) footnote--markers-alist) 570 (push `(,arg nil ,marker) footnote--markers-alist)
@@ -601,8 +593,9 @@ Presumes we're within the footnote area already."
601(defun footnote--insert-footnote (arg) 593(defun footnote--insert-footnote (arg)
602 "Insert a footnote numbered ARG, at (point)." 594 "Insert a footnote numbered ARG, at (point)."
603 (push-mark) 595 (push-mark)
604 (footnote--insert-pointer-marker arg (point)) 596 (let ((old-point (point)))
605 (footnote--insert-numbered-footnote arg t) 597 (footnote--insert-numbered-footnote arg t)
598 (footnote--insert-pointer-marker arg old-point))
606 (footnote--goto-char-point-max) 599 (footnote--goto-char-point-max)
607 (if (footnote--goto-first) 600 (if (footnote--goto-first)
608 (save-restriction 601 (save-restriction
@@ -615,10 +608,7 @@ Presumes we're within the footnote area already."
615 (when (re-search-forward 608 (when (re-search-forward
616 (if footnote-spaced-footnotes 609 (if footnote-spaced-footnotes
617 "\n\n" 610 "\n\n"
618 (concat "\n" 611 (concat "\n" (footnote--current-regexp)))
619 (regexp-quote footnote-start-tag)
620 (footnote--current-regexp)
621 (regexp-quote footnote-end-tag)))
622 nil t) 612 nil t)
623 (unless (beginning-of-line) t)) 613 (unless (beginning-of-line) t))
624 (footnote--goto-char-point-max) 614 (footnote--goto-char-point-max)
@@ -730,10 +720,12 @@ footnote area, returns `point-max'."
730;;; User functions 720;;; User functions
731 721
732(defun footnote--make-hole () 722(defun footnote--make-hole ()
723 "Make room in the alist for a new footnote at point.
724Return the footnote number to use."
733 (save-excursion 725 (save-excursion
734 (let (rc) 726 (let (rc)
735 (dolist (alist-elem footnote--markers-alist) 727 (dolist (alist-elem footnote--markers-alist)
736 (when (< (point) (- (cl-caddr alist-elem) 3)) 728 (when (<= (point) (cl-caddr alist-elem))
737 (unless rc 729 (unless rc
738 (setq rc (car alist-elem))) 730 (setq rc (car alist-elem)))
739 (save-excursion 731 (save-excursion
@@ -743,7 +735,8 @@ footnote area, returns `point-max'."
743 (1+ (car alist-elem)))) 735 (1+ (car alist-elem))))
744 (footnote--renumber (1+ (car alist-elem)) 736 (footnote--renumber (1+ (car alist-elem))
745 alist-elem)))) 737 alist-elem))))
746 rc))) 738 (or rc
739 (1+ (or (caar (last footnote--markers-alist)) 0))))))
747 740
748(defun footnote-add-footnote () 741(defun footnote-add-footnote ()
749 "Add a numbered footnote. 742 "Add a numbered footnote.
@@ -753,27 +746,17 @@ If the variable `footnote-narrow-to-footnotes-when-editing' is set,
753the buffer is narrowed to the footnote body. The restriction is removed 746the buffer is narrowed to the footnote body. The restriction is removed
754by using `footnote-back-to-message'." 747by using `footnote-back-to-message'."
755 (interactive "*") 748 (interactive "*")
756 (let ((num 749 (let ((num (footnote--make-hole)))
757 (if footnote--markers-alist
758 (let ((last (car (last footnote--markers-alist))))
759 (if (< (point) (cl-caddr last))
760 (footnote--make-hole)
761 (1+ (car last))))
762 1)))
763 (message "Adding footnote %d" num) 750 (message "Adding footnote %d" num)
764 (footnote--insert-footnote num) 751 (footnote--insert-footnote num)
765 (insert-before-markers (make-string footnote-body-tag-spacing ? )) 752 (insert (make-string footnote-body-tag-spacing ? ))
766 (let ((opoint (point))) 753 (save-excursion
767 (save-excursion 754 (insert
768 (insert-before-markers 755 (if footnote-spaced-footnotes
769 (if footnote-spaced-footnotes 756 "\n\n"
770 "\n\n" 757 "\n"))
771 "\n")) 758 (when footnote-narrow-to-footnotes-when-editing
772 (when footnote-narrow-to-footnotes-when-editing 759 (footnote--narrow-to-footnotes)))))
773 (footnote--narrow-to-footnotes)))
774 ;; Emacs/XEmacs bug? save-excursion doesn't restore point when using
775 ;; insert-before-markers.
776 (goto-char opoint))))
777 760
778(defun footnote-delete-footnote (&optional arg) 761(defun footnote-delete-footnote (&optional arg)
779 "Delete a numbered footnote. 762 "Delete a numbered footnote.
@@ -787,14 +770,11 @@ delete the footnote with that number."
787 (y-or-n-p (format "Really delete footnote %d?" arg)))) 770 (y-or-n-p (format "Really delete footnote %d?" arg))))
788 (let ((alist-elem (or (assq arg footnote--markers-alist) 771 (let ((alist-elem (or (assq arg footnote--markers-alist)
789 (error "Can't delete footnote %d" arg))) 772 (error "Can't delete footnote %d" arg)))
790 (fn-regexp (concat (regexp-quote footnote-start-tag) 773 (fn-regexp (footnote--current-regexp)))
791 (footnote--current-regexp)
792 (regexp-quote footnote-end-tag))))
793 (dolist (locn (cddr alist-elem)) 774 (dolist (locn (cddr alist-elem))
794 (save-excursion 775 (save-excursion
795 (goto-char locn) 776 (goto-char locn)
796 (when (looking-back fn-regexp 777 (when (looking-at fn-regexp)
797 (line-beginning-position))
798 (delete-region (match-beginning 0) (match-end 0))))) 778 (delete-region (match-beginning 0) (match-end 0)))))
799 (save-excursion 779 (save-excursion
800 (goto-char (cadr alist-elem)) 780 (goto-char (cadr alist-elem))
@@ -867,7 +847,9 @@ being set it is automatically widened."
867 (when note 847 (when note
868 (when footnote-narrow-to-footnotes-when-editing 848 (when footnote-narrow-to-footnotes-when-editing
869 (widen)) 849 (widen))
870 (goto-char (cl-caddr (assq note footnote--markers-alist)))))) 850 (goto-char (cl-caddr (assq note footnote--markers-alist)))
851 (when (looking-at (footnote--current-regexp))
852 (goto-char (match-end 0))))))
871 853
872(defvar footnote-mode-map 854(defvar footnote-mode-map
873 (let ((map (make-sparse-keymap))) 855 (let ((map (make-sparse-keymap)))
diff --git a/test/lisp/mail/footnote-tests.el b/test/lisp/mail/footnote-tests.el
new file mode 100644
index 00000000000..464443f4039
--- /dev/null
+++ b/test/lisp/mail/footnote-tests.el
@@ -0,0 +1,47 @@
1;;; footnote-tests.el --- Tests for footnote-mode -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2019 Free Software Foundation, Inc.
4
5;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6;; Keywords:
7
8;; This program is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; This program is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program. If not, see <https://www.gnu.org/licenses/>.
20
21;;; Commentary:
22
23;;
24
25;;; Code:
26
27(ert-deftest footnote-tests-same-place ()
28 (with-temp-buffer
29 (footnote-mode 1)
30 (insert "hello world")
31 (beginning-of-line) (forward-word)
32 (footnote-add-footnote)
33 (insert "footnote")
34 (footnote-back-to-message)
35 (should (equal (buffer-substring (point-min) (point))
36 "hello[1]"))
37 (beginning-of-line) (forward-word)
38 (footnote-add-footnote)
39 (insert "other footnote")
40 (footnote-back-to-message)
41 (should (equal (buffer-substring (point-min) (point))
42 "hello[1]"))
43 (should (equal (buffer-substring (point-min) (line-end-position))
44 "hello[1][2] world"))))
45
46(provide 'footnote-tests)
47;;; footnote-tests.el ends here