aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-05-01 17:53:39 -0400
committerStefan Monnier2019-05-01 17:53:39 -0400
commit4299e5ef9af182cbc1d97f8a22b589901e6494b1 (patch)
tree893da7cc1e5e84cd419306403f950a7256a5cc28
parentc9b820ddcfb7e44b4aa1ac349de9cf8453bca6bd (diff)
downloademacs-4299e5ef9af182cbc1d97f8a22b589901e6494b1.tar.gz
emacs-4299e5ef9af182cbc1d97f8a22b589901e6494b1.zip
* lisp/mail/footnote.el: Consolidate the two marker-alists
Consolidate footnote-text-marker-alist and footnote-pointer-marker-alist into a single footnote--markers-alist. (footnote--markers-alist): New var. (footnote-text-marker-alist, footnote-pointer-marker-alist): Delete vars. (footnote--refresh-footnotes, footnote--text-under-cursor) (footnote--calc-fn-alignment-column, footnote-add-footnote) (footnote-goto-footnote, footnote-back-to-message): Adjust accordingly. (footnote--make-hole, footnote-delete-footnote) (footnote-renumber-footnotes): Simplify accordingly. (footnote-cycle-style): Indicate style name in echo area. (footnote--renumber): Take a single `alist-elem` arg instead of `pointer-alist` and `text-alist`. (footnote--insert-text-marker, footnote--insert-pointer-marker): Add to footnote--markers-alist instead. (footnote--first-text-marker): New function. (footnote--get-area-point-min): Use it. footnote--goto-first): New function. (footnote--insert-footnote): Use it. (footnote-style-number): Use defvar-local.
-rw-r--r--lisp/mail/footnote.el191
1 files changed, 94 insertions, 97 deletions
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index a1e909cee70..ef359b62b40 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -157,17 +157,14 @@ left with the first character of footnote text."
157 157
158;;; Private variables 158;;; Private variables
159 159
160(defvar footnote-style-number nil 160(defvar-local footnote-style-number nil
161 "Footnote style represented as an index into footnote-style-alist.") 161 "Footnote style represented as an index into `footnote-style-alist'.")
162(make-variable-buffer-local 'footnote-style-number)
163 162
164(defvar footnote-text-marker-alist nil 163(defvar-local footnote--markers-alist nil
165 "List of markers pointing to text of footnotes in message buffer.") 164 "List of (FN TEXT . POINTERS).
166(make-variable-buffer-local 'footnote-text-marker-alist) 165Where FN is the footnote number, TEXT is a marker pointing to
167 166the footnote's text, and POINTERS is a list of markers pointing
168(defvar footnote-pointer-marker-alist nil 167to the places from which the footnote is referenced.")
169 "List of markers pointing to footnote pointers in message buffer.")
170(make-variable-buffer-local 'footnote-pointer-marker-alist)
171 168
172(defvar footnote-mouse-highlight 'highlight 169(defvar footnote-mouse-highlight 'highlight
173 ;; FIXME: This `highlight' property is not currently used. 170 ;; FIXME: This `highlight' property is not currently used.
@@ -462,8 +459,8 @@ styles."
462 (save-excursion 459 (save-excursion
463 ;; Take care of the pointers first 460 ;; Take care of the pointers first
464 (let ((i 0) locn alist) 461 (let ((i 0) locn alist)
465 (while (setq alist (nth i footnote-pointer-marker-alist)) 462 (while (setq alist (nth i footnote--markers-alist))
466 (setq locn (cdr alist)) 463 (setq locn (cddr alist))
467 (while locn 464 (while locn
468 (goto-char (car locn)) 465 (goto-char (car locn))
469 ;; Try to handle the case where `footnote-start-tag' and 466 ;; Try to handle the case where `footnote-start-tag' and
@@ -486,8 +483,8 @@ styles."
486 483
487 ;; Now take care of the text section 484 ;; Now take care of the text section
488 (let ((i 0) alist) 485 (let ((i 0) alist)
489 (while (setq alist (nth i footnote-text-marker-alist)) 486 (while (setq alist (nth i footnote--markers-alist))
490 (goto-char (cdr alist)) 487 (goto-char (cadr alist))
491 (when (looking-at (concat 488 (when (looking-at (concat
492 (regexp-quote footnote-start-tag) 489 (regexp-quote footnote-start-tag)
493 "\\(" index-regexp "+\\)" 490 "\\(" index-regexp "+\\)"
@@ -508,7 +505,8 @@ styles."
508 (let ((old-desc (assq footnote-style footnote-style-alist))) 505 (let ((old-desc (assq footnote-style footnote-style-alist)))
509 (setq footnote-style (caar (or (cdr (memq old-desc footnote-style-alist)) 506 (setq footnote-style (caar (or (cdr (memq old-desc footnote-style-alist))
510 footnote-style-alist))) 507 footnote-style-alist)))
511 (footnote--refresh-footnotes (nth 2 old-desc)))) 508 (footnote--refresh-footnotes (nth 2 old-desc))
509 (message "Style set to %s" footnote-style)))
512 510
513(defun footnote-set-style (style) 511(defun footnote-set-style (style)
514 "Select a specific style." 512 "Select a specific style."
@@ -532,11 +530,10 @@ styles."
532 string 'footnote-number arg footnote-mouse-highlight t) 530 string 'footnote-number arg footnote-mouse-highlight t)
533 (propertize string 'footnote-number arg))))) 531 (propertize string 'footnote-number arg)))))
534 532
535(defun footnote--renumber (to pointer-alist text-alist) 533(defun footnote--renumber (to alist-elem)
536 "Renumber a single footnote." 534 "Renumber a single footnote."
537 (let* ((posn-list (cdr pointer-alist))) 535 (let* ((posn-list (cddr alist-elem)))
538 (setcar pointer-alist to) 536 (setcar alist-elem to)
539 (setcar text-alist to)
540 (while posn-list 537 (while posn-list
541 (goto-char (car posn-list)) 538 (goto-char (car posn-list))
542 (when (looking-back (concat (regexp-quote footnote-start-tag) 539 (when (looking-back (concat (regexp-quote footnote-start-tag)
@@ -550,7 +547,7 @@ styles."
550 footnote-end-tag) 547 footnote-end-tag)
551 'footnote-number to footnote-mouse-highlight t))) 548 'footnote-number to footnote-mouse-highlight t)))
552 (setq posn-list (cdr posn-list))) 549 (setq posn-list (cdr posn-list)))
553 (goto-char (cdr text-alist)) 550 (goto-char (cadr alist-elem))
554 (when (looking-at (concat (regexp-quote footnote-start-tag) 551 (when (looking-at (concat (regexp-quote footnote-start-tag)
555 (footnote--current-regexp) 552 (footnote--current-regexp)
556 (regexp-quote footnote-end-tag))) 553 (regexp-quote footnote-end-tag)))
@@ -575,26 +572,43 @@ styles."
575 572
576(defun footnote--insert-text-marker (arg locn) 573(defun footnote--insert-text-marker (arg locn)
577 "Insert a marker pointing to footnote ARG, at buffer location LOCN." 574 "Insert a marker pointing to footnote ARG, at buffer location LOCN."
578 (let ((marker (make-marker))) 575 (let ((entry (assq arg footnote--markers-alist)))
579 (unless (assq arg footnote-text-marker-alist) 576 (unless (cadr entry)
580 (set-marker marker locn) 577 (let ((marker (copy-marker locn)))
581 (setq footnote-text-marker-alist 578 (if entry
582 (cons (cons arg marker) footnote-text-marker-alist)) 579 (setf (cadr entry) marker)
583 (setq footnote-text-marker-alist 580 (push `(,arg ,marker) footnote--markers-alist)
584 (footnote--sort footnote-text-marker-alist))))) 581 (setq footnote--markers-alist
582 (footnote--sort footnote--markers-alist)))))))
585 583
586(defun footnote--insert-pointer-marker (arg locn) 584(defun footnote--insert-pointer-marker (arg locn)
587 "Insert a marker pointing to footnote ARG, at buffer location LOCN." 585 "Insert a marker pointing to footnote ARG, at buffer location LOCN."
588 (let ((marker (make-marker)) 586 (let ((entry (assq arg footnote--markers-alist))
589 alist) 587 (marker (copy-marker locn)))
590 (set-marker marker locn) 588 (if entry
591 (if (setq alist (assq arg footnote-pointer-marker-alist)) 589 (push marker (cddr entry))
592 (setf alist 590 (push `(,arg nil ,marker) footnote--markers-alist)
593 (cons marker (cdr alist))) 591 (setq footnote--markers-alist
594 (setq footnote-pointer-marker-alist 592 (footnote--sort footnote--markers-alist)))))
595 (cons (cons arg (list marker)) footnote-pointer-marker-alist)) 593
596 (setq footnote-pointer-marker-alist 594(defun footnote--first-text-marker ()
597 (footnote--sort footnote-pointer-marker-alist))))) 595 (let ((tmp footnote--markers-alist))
596 (while (and tmp (null (cadr (car footnote--markers-alist))))
597 ;; Skip entries which don't (yet) have a TEXT marker.
598 (set tmp (cdr tmp)))
599 (cadr (car tmp))))
600
601(defun footnote--goto-first ()
602 "Go to beginning of footnote area and return non-nil if successful.
603Presumes we're within the footnote area already."
604 (cond
605 ((not (string-equal footnote-section-tag ""))
606 (re-search-backward
607 (concat "^" footnote-section-tag-regexp) nil t))
608 (footnote--markers-alist
609 (let ((pos (footnote--first-text-marker)))
610 (when pos
611 (goto-char pos))))))
598 612
599(defun footnote--insert-footnote (arg) 613(defun footnote--insert-footnote (arg)
600 "Insert a footnote numbered ARG, at (point)." 614 "Insert a footnote numbered ARG, at (point)."
@@ -602,11 +616,7 @@ styles."
602 (footnote--insert-pointer-marker arg (point)) 616 (footnote--insert-pointer-marker arg (point))
603 (footnote--insert-numbered-footnote arg t) 617 (footnote--insert-numbered-footnote arg t)
604 (footnote--goto-char-point-max) 618 (footnote--goto-char-point-max)
605 (if (cond 619 (if (footnote--goto-first)
606 ((not (string-equal footnote-section-tag ""))
607 (re-search-backward (concat "^" footnote-section-tag-regexp) nil t))
608 (footnote-text-marker-alist
609 (goto-char (cdar footnote-text-marker-alist))))
610 (save-restriction 620 (save-restriction
611 (when footnote-narrow-to-footnotes-when-editing 621 (when footnote-narrow-to-footnotes-when-editing
612 (footnote--narrow-to-footnotes)) 622 (footnote--narrow-to-footnotes))
@@ -624,12 +634,7 @@ styles."
624 nil t) 634 nil t)
625 (unless (beginning-of-line) t)) 635 (unless (beginning-of-line) t))
626 (footnote--goto-char-point-max) 636 (footnote--goto-char-point-max)
627 (cond 637 (footnote--goto-first))))
628 ((not (string-equal footnote-section-tag ""))
629 (re-search-backward
630 (concat "^" footnote-section-tag-regexp) nil t))
631 (footnote-text-marker-alist
632 (goto-char (cdar footnote-text-marker-alist)))))))
633 (unless (looking-at "^$") 638 (unless (looking-at "^$")
634 (insert "\n")) 639 (insert "\n"))
635 (when (eobp) 640 (when (eobp)
@@ -647,18 +652,18 @@ styles."
647 "Return the number of the current footnote if in footnote text. 652 "Return the number of the current footnote if in footnote text.
648Return nil if the cursor is not positioned over the text of 653Return nil if the cursor is not positioned over the text of
649a footnote." 654a footnote."
650 (when (and footnote-text-marker-alist 655 (when (and footnote--markers-alist
651 (<= (footnote--get-area-point-min) 656 (<= (footnote--get-area-point-min)
652 (point) 657 (point)
653 (footnote--get-area-point-max))) 658 (footnote--get-area-point-max)))
654 (let ((i 1) alist-txt result) 659 (let ((i 1) alist-txt result)
655 (while (and (setq alist-txt (nth i footnote-text-marker-alist)) 660 (while (and (setq alist-txt (nth i footnote--markers-alist))
656 (null result)) 661 (null result))
657 (when (< (point) (cdr alist-txt)) 662 (when (< (point) (cadr alist-txt))
658 (setq result (car (nth (1- i) footnote-text-marker-alist)))) 663 (setq result (car (nth (1- i) footnote--markers-alist))))
659 (setq i (1+ i))) 664 (setq i (1+ i)))
660 (when (and (null result) (null alist-txt)) 665 (when (and (null result) (null alist-txt))
661 (setq result (car (nth (1- i) footnote-text-marker-alist)))) 666 (setq result (car (nth (1- i) footnote--markers-alist))))
662 result))) 667 result)))
663 668
664(defun footnote--under-cursor () 669(defun footnote--under-cursor ()
@@ -675,7 +680,7 @@ Return nil if the cursor is not over a footnote."
675 (string-width 680 (string-width
676 (concat footnote-start-tag footnote-end-tag 681 (concat footnote-start-tag footnote-end-tag
677 (footnote--index-to-string 682 (footnote--index-to-string
678 (caar (last footnote-text-marker-alist))))))) 683 (caar (last footnote--markers-alist)))))))
679 684
680(defun footnote--fill-prefix-string () 685(defun footnote--fill-prefix-string ()
681 "Return the fill prefix to be used by footnote mode." 686 "Return the fill prefix to be used by footnote mode."
@@ -695,13 +700,12 @@ With optional arg BEFORE-TAG, return position of the `footnote-section-tag'
695instead, if applicable." 700instead, if applicable."
696 (cond 701 (cond
697 ;; FIXME: Shouldn't we use `footnote--get-area-point-max' instead? 702 ;; FIXME: Shouldn't we use `footnote--get-area-point-max' instead?
698 ((not footnote-text-marker-alist) (point-max)) 703 ((not (footnote--first-text-marker)) (point-max))
699 ((not before-tag) (cdr (car footnote-text-marker-alist))) 704 ((not before-tag) (footnote--first-text-marker))
700 ((string-equal footnote-section-tag "") 705 ((string-equal footnote-section-tag "") (footnote--first-text-marker))
701 (cdr (car footnote-text-marker-alist)))
702 (t 706 (t
703 (save-excursion 707 (save-excursion
704 (goto-char (cdr (car footnote-text-marker-alist))) 708 (goto-char (footnote--first-text-marker))
705 (if (re-search-backward (concat "^" footnote-section-tag-regexp) nil t) 709 (if (re-search-backward (concat "^" footnote-section-tag-regexp) nil t)
706 (match-beginning 0) 710 (match-beginning 0)
707 (message "Footnote section tag not found!") 711 (message "Footnote section tag not found!")
@@ -721,7 +725,7 @@ instead, if applicable."
721 ;; function, and repeat. 725 ;; function, and repeat.
722 ;; 726 ;;
723 ;; TODO: integrate sanity checks at reasonable operational points. 727 ;; TODO: integrate sanity checks at reasonable operational points.
724 (cdr (car footnote-text-marker-alist))))))) 728 (footnote--first-text-marker))))))
725 729
726(defun footnote--get-area-point-max () 730(defun footnote--get-area-point-max ()
727 "Return the end of footnote area. 731 "Return the end of footnote area.
@@ -747,22 +751,20 @@ footnote area, returns `point-max'."
747(defun footnote--make-hole () 751(defun footnote--make-hole ()
748 (save-excursion 752 (save-excursion
749 (let ((i 0) 753 (let ((i 0)
750 (notes (length footnote-pointer-marker-alist)) 754 (notes (length footnote--markers-alist))
751 alist-ptr alist-txt rc) 755 alist-elem rc)
752 (while (< i notes) 756 (while (< i notes)
753 (setq alist-ptr (nth i footnote-pointer-marker-alist)) 757 (setq alist-elem (nth i footnote--markers-alist))
754 (setq alist-txt (nth i footnote-text-marker-alist)) 758 (when (< (point) (- (cl-caddr alist-elem) 3))
755 (when (< (point) (- (cadr alist-ptr) 3))
756 (unless rc 759 (unless rc
757 (setq rc (car alist-ptr))) 760 (setq rc (car alist-elem)))
758 (save-excursion 761 (save-excursion
759 (message "Renumbering from %s to %s" 762 (message "Renumbering from %s to %s"
760 (footnote--index-to-string (car alist-ptr)) 763 (footnote--index-to-string (car alist-elem))
761 (footnote--index-to-string 764 (footnote--index-to-string
762 (1+ (car alist-ptr)))) 765 (1+ (car alist-elem))))
763 (footnote--renumber (1+ (car alist-ptr)) 766 (footnote--renumber (1+ (car alist-elem))
764 alist-ptr 767 alist-elem)))
765 alist-txt)))
766 (setq i (1+ i))) 768 (setq i (1+ i)))
767 rc))) 769 rc)))
768 770
@@ -775,10 +777,10 @@ the buffer is narrowed to the footnote body. The restriction is removed
775by using `footnote-back-to-message'." 777by using `footnote-back-to-message'."
776 (interactive "*") 778 (interactive "*")
777 (let ((num 779 (let ((num
778 (if footnote-text-marker-alist 780 (if footnote--markers-alist
779 (if (< (point) (cl-cadar (last footnote-pointer-marker-alist))) 781 (if (< (point) (cl-caddar (last footnote--markers-alist)))
780 (footnote--make-hole) 782 (footnote--make-hole)
781 (1+ (caar (last footnote-text-marker-alist)))) 783 (1+ (caar (last footnote--markers-alist))))
782 1))) 784 1)))
783 (message "Adding footnote %d" num) 785 (message "Adding footnote %d" num)
784 (footnote--insert-footnote num) 786 (footnote--insert-footnote num)
@@ -805,12 +807,11 @@ delete the footnote with that number."
805 (when (and arg 807 (when (and arg
806 (or (not footnote-prompt-before-deletion) 808 (or (not footnote-prompt-before-deletion)
807 (y-or-n-p (format "Really delete footnote %d?" arg)))) 809 (y-or-n-p (format "Really delete footnote %d?" arg))))
808 (let (alist-ptr alist-txt locn) 810 (let (alist-elem locn)
809 (setq alist-ptr (assq arg footnote-pointer-marker-alist)) 811 (setq alist-elem (assq arg footnote--markers-alist))
810 (setq alist-txt (assq arg footnote-text-marker-alist)) 812 (unless alist-elem
811 (unless (and alist-ptr alist-txt)
812 (error "Can't delete footnote %d" arg)) 813 (error "Can't delete footnote %d" arg))
813 (setq locn (cdr alist-ptr)) 814 (setq locn (cddr alist-elem))
814 (while (car locn) 815 (while (car locn)
815 (save-excursion 816 (save-excursion
816 (goto-char (car locn)) 817 (goto-char (car locn))
@@ -821,7 +822,7 @@ delete the footnote with that number."
821 (delete-region (match-beginning 0) (match-end 0)))) 822 (delete-region (match-beginning 0) (match-end 0))))
822 (setq locn (cdr locn))) 823 (setq locn (cdr locn)))
823 (save-excursion 824 (save-excursion
824 (goto-char (cdr alist-txt)) 825 (goto-char (cadr alist-elem))
825 (delete-region 826 (delete-region
826 (point) 827 (point)
827 (if footnote-spaced-footnotes 828 (if footnote-spaced-footnotes
@@ -830,13 +831,10 @@ delete the footnote with that number."
830 (end-of-line) 831 (end-of-line)
831 (next-single-char-property-change 832 (next-single-char-property-change
832 (point) 'footnote-number nil (footnote--goto-char-point-max)))))) 833 (point) 'footnote-number nil (footnote--goto-char-point-max))))))
833 (setq footnote-pointer-marker-alist 834 (setq footnote--markers-alist
834 (delq alist-ptr footnote-pointer-marker-alist)) 835 (delq alist-elem footnote--markers-alist))
835 (setq footnote-text-marker-alist
836 (delq alist-txt footnote-text-marker-alist))
837 (footnote-renumber-footnotes) 836 (footnote-renumber-footnotes)
838 (when (and (null footnote-text-marker-alist) 837 (when (null footnote--markers-alist)
839 (null footnote-pointer-marker-alist))
840 (save-excursion 838 (save-excursion
841 (if (not (string-equal footnote-section-tag "")) 839 (if (not (string-equal footnote-section-tag ""))
842 (let* ((end (footnote--goto-char-point-max)) 840 (let* ((end (footnote--goto-char-point-max))
@@ -858,13 +856,12 @@ delete the footnote with that number."
858 (interactive "*") 856 (interactive "*")
859 (save-excursion 857 (save-excursion
860 (let ((i 0) 858 (let ((i 0)
861 (notes (length footnote-pointer-marker-alist)) 859 (notes (length footnote--markers-alist))
862 alist-ptr alist-txt) 860 alist-elem)
863 (while (< i notes) 861 (while (< i notes)
864 (setq alist-ptr (nth i footnote-pointer-marker-alist)) 862 (setq alist-elem (nth i footnote--markers-alist))
865 (setq alist-txt (nth i footnote-text-marker-alist)) 863 (unless (= (1+ i) (car alist-elem))
866 (unless (= (1+ i) (car alist-ptr)) 864 (footnote--renumber (1+ i) alist-elem))
867 (footnote--renumber (1+ i) alist-ptr alist-txt))
868 (setq i (1+ i)))))) 865 (setq i (1+ i))))))
869 866
870(defun footnote-goto-footnote (&optional arg) 867(defun footnote-goto-footnote (&optional arg)
@@ -874,18 +871,18 @@ specified, jump to the text of that footnote."
874 (interactive "P") 871 (interactive "P")
875 (unless arg 872 (unless arg
876 (setq arg (footnote--under-cursor))) 873 (setq arg (footnote--under-cursor)))
877 (let ((footnote (assq arg footnote-text-marker-alist))) 874 (let ((footnote (assq arg footnote--markers-alist)))
878 (cond 875 (cond
879 (footnote 876 (footnote
880 (goto-char (cdr footnote))) 877 (goto-char (cadr footnote)))
881 ((eq arg 0) 878 ((eq arg 0)
882 (goto-char (point-max)) 879 (goto-char (point-max))
883 (cond 880 (cond
884 ((not (string-equal footnote-section-tag "")) 881 ((not (string-equal footnote-section-tag ""))
885 (re-search-backward (concat "^" footnote-section-tag-regexp)) 882 (re-search-backward (concat "^" footnote-section-tag-regexp))
886 (forward-line 1)) 883 (forward-line 1))
887 (footnote-text-marker-alist 884 ((footnote--first-text-marker)
888 (goto-char (cdar footnote-text-marker-alist))))) 885 (goto-char (footnote--first-text-marker)))))
889 (t 886 (t
890 (error "I don't see a footnote here"))))) 887 (error "I don't see a footnote here")))))
891 888
@@ -899,7 +896,7 @@ being set it is automatically widened."
899 (when note 896 (when note
900 (when footnote-narrow-to-footnotes-when-editing 897 (when footnote-narrow-to-footnotes-when-editing
901 (widen)) 898 (widen))
902 (goto-char (cadr (assq note footnote-pointer-marker-alist)))))) 899 (goto-char (cl-caddr (assq note footnote--markers-alist))))))
903 900
904(defvar footnote-mode-map 901(defvar footnote-mode-map
905 (let ((map (make-sparse-keymap))) 902 (let ((map (make-sparse-keymap)))