diff options
| author | Stefan Monnier | 2019-05-02 10:27:42 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-05-02 10:27:42 -0400 |
| commit | 3fa9c9f774277530f4dac6c4f5de157cb4cdc536 (patch) | |
| tree | 85d264dd468711f50172ed9d38dafddde97bdc11 | |
| parent | e10e314e2b7583d892e86cee92ec57d3a1030ce4 (diff) | |
| download | emacs-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.el | 92 | ||||
| -rw-r--r-- | test/lisp/mail/footnote-tests.el | 47 |
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." | |||
| 165 | Where FN is the footnote number, TEXT is a marker pointing to | 165 | Where FN is the footnote number, TEXT is a marker pointing to |
| 166 | the footnote's text, and POINTERS is a list of markers pointing | 166 | the footnote's text, and POINTERS is a list of markers pointing |
| 167 | to the places from which the footnote is referenced. | 167 | to the places from which the footnote is referenced. |
| 168 | TEXT points right *before* the [...] and POINTERS point right | 168 | Both 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. |
| 457 | You must call this or arrange to have this called after changing | 455 | You must call this or arrange to have this called after changing |
| 458 | footnote styles." | 456 | footnote 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. | ||
| 724 | Return 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, | |||
| 753 | the buffer is narrowed to the footnote body. The restriction is removed | 746 | the buffer is narrowed to the footnote body. The restriction is removed |
| 754 | by using `footnote-back-to-message'." | 747 | by 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 | ||