aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/textmodes
diff options
context:
space:
mode:
authorAlan Mackenzie2017-02-05 16:28:53 +0000
committerAlan Mackenzie2017-02-05 16:28:53 +0000
commitd5514332d4a6092673ce1f78fadcae0c57f7be64 (patch)
tree1780337154904dcfad8ecfa76614b47c082160dd /lisp/textmodes
parentcecc25c68f5a1834c356e18259aa2af402a70ce1 (diff)
parentde3336051ef74e0c3069374ced5b5fc7bb9fba15 (diff)
downloademacs-d5514332d4a6092673ce1f78fadcae0c57f7be64.tar.gz
emacs-d5514332d4a6092673ce1f78fadcae0c57f7be64.zip
Merge branch 'master' into comment-cache
Diffstat (limited to 'lisp/textmodes')
-rw-r--r--lisp/textmodes/artist.el2
-rw-r--r--lisp/textmodes/bib-mode.el2
-rw-r--r--lisp/textmodes/bibtex-style.el2
-rw-r--r--lisp/textmodes/bibtex.el2
-rw-r--r--lisp/textmodes/conf-mode.el2
-rw-r--r--lisp/textmodes/css-mode.el5
-rw-r--r--lisp/textmodes/dns-mode.el9
-rw-r--r--lisp/textmodes/enriched.el2
-rw-r--r--lisp/textmodes/fill.el2
-rw-r--r--lisp/textmodes/flyspell.el2
-rw-r--r--lisp/textmodes/ispell.el11
-rw-r--r--lisp/textmodes/makeinfo.el2
-rw-r--r--lisp/textmodes/nroff-mode.el2
-rw-r--r--lisp/textmodes/page-ext.el2
-rw-r--r--lisp/textmodes/page.el2
-rw-r--r--lisp/textmodes/paragraphs.el2
-rw-r--r--lisp/textmodes/picture.el2
-rw-r--r--lisp/textmodes/po.el2
-rw-r--r--lisp/textmodes/refbib.el2
-rw-r--r--lisp/textmodes/refer.el2
-rw-r--r--lisp/textmodes/refill.el2
-rw-r--r--lisp/textmodes/reftex-auc.el2
-rw-r--r--lisp/textmodes/reftex-cite.el2
-rw-r--r--lisp/textmodes/reftex-dcr.el2
-rw-r--r--lisp/textmodes/reftex-global.el2
-rw-r--r--lisp/textmodes/reftex-index.el2
-rw-r--r--lisp/textmodes/reftex-parse.el7
-rw-r--r--lisp/textmodes/reftex-ref.el2
-rw-r--r--lisp/textmodes/reftex-sel.el2
-rw-r--r--lisp/textmodes/reftex-toc.el2
-rw-r--r--lisp/textmodes/reftex-vars.el18
-rw-r--r--lisp/textmodes/reftex.el6
-rw-r--r--lisp/textmodes/remember.el2
-rw-r--r--lisp/textmodes/rst.el3157
-rw-r--r--lisp/textmodes/sgml-mode.el2
-rw-r--r--lisp/textmodes/table.el2
-rw-r--r--lisp/textmodes/tex-mode.el2
-rw-r--r--lisp/textmodes/texinfmt.el2
-rw-r--r--lisp/textmodes/texinfo.el2
-rw-r--r--lisp/textmodes/texnfo-upd.el2
-rw-r--r--lisp/textmodes/text-mode.el2
-rw-r--r--lisp/textmodes/tildify.el2
-rw-r--r--lisp/textmodes/two-column.el2
-rw-r--r--lisp/textmodes/underline.el2
44 files changed, 1676 insertions, 1611 deletions
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 6342110f20b..596570ca4e2 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -1,6 +1,6 @@
1;;; artist.el --- draw ascii graphics with your mouse 1;;; artist.el --- draw ascii graphics with your mouse
2 2
3;; Copyright (C) 2000-2016 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
4 4
5;; Author: Tomas Abrahamsson <tab@lysator.liu.se> 5;; Author: Tomas Abrahamsson <tab@lysator.liu.se>
6;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se> 6;; Maintainer: Tomas Abrahamsson <tab@lysator.liu.se>
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el
index 8b40558e3a4..74d214496e2 100644
--- a/lisp/textmodes/bib-mode.el
+++ b/lisp/textmodes/bib-mode.el
@@ -1,6 +1,6 @@
1;;; bib-mode.el --- major mode for editing bib files 1;;; bib-mode.el --- major mode for editing bib files
2 2
3;; Copyright (C) 1989, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1989, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Author: Henry Kautz 5;; Author: Henry Kautz
6;; (according to authors.el) 6;; (according to authors.el)
diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el
index f4113e1c27c..393bbd1c3af 100644
--- a/lisp/textmodes/bibtex-style.el
+++ b/lisp/textmodes/bibtex-style.el
@@ -1,6 +1,6 @@
1;;; bibtex-style.el --- Major mode for BibTeX Style files -*- lexical-binding: t -*- 1;;; bibtex-style.el --- Major mode for BibTeX Style files -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2005, 2007-2016 Free Software Foundation, Inc. 3;; Copyright (C) 2005, 2007-2017 Free Software Foundation, Inc.
4 4
5;; Author: Stefan Monnier <monnier@iro.umontreal.ca> 5;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6;; Keywords: tex 6;; Keywords: tex
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index bc9bf799f9b..6cbdc1efd85 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,6 +1,6 @@
1;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*- 1;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1992, 1994-1999, 2001-2016 Free Software Foundation, 3;; Copyright (C) 1992, 1994-1999, 2001-2017 Free Software Foundation,
4;; Inc. 4;; Inc.
5 5
6;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de> 6;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index 8ae8b0bfb11..054d8dbb8b2 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -1,6 +1,6 @@
1;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files 1;;; conf-mode.el --- Simple major mode for editing conf/ini/properties files
2 2
3;; Copyright (C) 2004-2016 Free Software Foundation, Inc. 3;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
4 4
5;; Author: Daniel Pfeiffer <occitan@esperanto.org> 5;; Author: Daniel Pfeiffer <occitan@esperanto.org>
6;; Keywords: conf ini windows java 6;; Keywords: conf ini windows java
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 9e36a881a3e..c81c3f62e16 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1,6 +1,6 @@
1;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*- 1;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2006-2016 Free Software Foundation, Inc. 3;; Copyright (C) 2006-2017 Free Software Foundation, Inc.
4 4
5;; Author: Stefan Monnier <monnier@iro.umontreal.ca> 5;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6;; Maintainer: Simen Heggestøyl <simenheg@gmail.com> 6;; Maintainer: Simen Heggestøyl <simenheg@gmail.com>
@@ -27,7 +27,6 @@
27 27
28;;; Todo: 28;;; Todo:
29 29
30;; - electric ; and }
31;; - filling code with auto-fill-mode 30;; - filling code with auto-fill-mode
32;; - fix font-lock errors with multi-line selectors 31;; - fix font-lock errors with multi-line selectors
33 32
@@ -667,6 +666,8 @@ cannot be completed sensibly: `custom-ident',
667 ;; Variables. 666 ;; Variables.
668 (,(concat "--" css-ident-re) (0 font-lock-variable-name-face)) 667 (,(concat "--" css-ident-re) (0 font-lock-variable-name-face))
669 ;; Selectors. 668 ;; Selectors.
669 ;; Allow plain ":root" as a selector.
670 ("^[ \t]*\\(:root\\)\\(?:[\n \t]*\\)*{" (1 'css-selector keep))
670 ;; FIXME: attribute selectors don't work well because they may contain 671 ;; FIXME: attribute selectors don't work well because they may contain
671 ;; strings which have already been highlighted as f-l-string-face and 672 ;; strings which have already been highlighted as f-l-string-face and
672 ;; thus prevent this highlighting from being applied (actually now that 673 ;; thus prevent this highlighting from being applied (actually now that
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index 521b1f3358c..02cb2a2876d 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -1,6 +1,6 @@
1;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files 1;;; dns-mode.el --- a mode for viewing/editing Domain Name System master files
2 2
3;; Copyright (C) 2000-2001, 2004-2016 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2001, 2004-2017 Free Software Foundation, Inc.
4 4
5;; Author: Simon Josefsson <simon@josefsson.org> 5;; Author: Simon Josefsson <simon@josefsson.org>
6;; Keywords: DNS master zone file SOA comm 6;; Keywords: DNS master zone file SOA comm
@@ -32,6 +32,9 @@
32 32
33;; RFC 1034, "DOMAIN NAMES - CONCEPTS AND FACILITIES", P. Mockapetris. 33;; RFC 1034, "DOMAIN NAMES - CONCEPTS AND FACILITIES", P. Mockapetris.
34;; RFC 1035, "DOMAIN NAMES - IMPLEMENTATION AND SPECIFICATION", P. Mockapetris. 34;; RFC 1035, "DOMAIN NAMES - IMPLEMENTATION AND SPECIFICATION", P. Mockapetris.
35;; RFC 5155, "DNS Security (DNSSEC) Hashed Authenticated Denial of Existence"
36;; RFC 6698, "The DNS-Based Authentication of Named Entities (DANE)
37;; Transport Layer Security (TLS) Protocol: TLSA"
35 38
36;;; Release history: 39;;; Release history:
37 40
@@ -50,13 +53,13 @@
50 53
51(defconst dns-mode-types '("A" "NS" "MD" "MF" "CNAME" "SOA" "MB" "MG" "MR" 54(defconst dns-mode-types '("A" "NS" "MD" "MF" "CNAME" "SOA" "MB" "MG" "MR"
52 "NULL" "WKS" "PTR" "HINFO" "MINFO" "MX" "TXT" 55 "NULL" "WKS" "PTR" "HINFO" "MINFO" "MX" "TXT"
53 "RP" "AFSDB" "X25" "ISDN" "RT" "NSAP" "NSAP" 56 "RP" "AFSDB" "X25" "ISDN" "RT" "NSAP"
54 "SIG" "KEY" "PX" "GPOS" "AAAA" "LOC" "NXT" 57 "SIG" "KEY" "PX" "GPOS" "AAAA" "LOC" "NXT"
55 "EID" "NIMLOC" "SRV" "ATMA" "NAPTR" "KX" "CERT" 58 "EID" "NIMLOC" "SRV" "ATMA" "NAPTR" "KX" "CERT"
56 "A6" "DNAME" "SINK" "OPT" "APL" "DS" "SSHFP" 59 "A6" "DNAME" "SINK" "OPT" "APL" "DS" "SSHFP"
57 "RRSIG" "NSEC" "DNSKEY" "UINFO" "UID" "GID" 60 "RRSIG" "NSEC" "DNSKEY" "UINFO" "UID" "GID"
58 "UNSPEC" "TKEY" "TSIG" "IXFR" "AXFR" "MAILB" 61 "UNSPEC" "TKEY" "TSIG" "IXFR" "AXFR" "MAILB"
59 "MAILA") 62 "MAILA" "TLSA" "NSEC3")
60 "List of strings with known DNS types.") 63 "List of strings with known DNS types.")
61 64
62;; Font lock. 65;; Font lock.
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index 5562a75340a..7ace2a50486 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -1,6 +1,6 @@
1;;; enriched.el --- read and save files in text/enriched format 1;;; enriched.el --- read and save files in text/enriched format
2 2
3;; Copyright (C) 1994-1996, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1994-1996, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Author: Boris Goldowsky <boris@gnu.org> 5;; Author: Boris Goldowsky <boris@gnu.org>
6;; Keywords: wp, faces 6;; Keywords: wp, faces
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 173d1c9d196..2957bc62d97 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -1,6 +1,6 @@
1;;; fill.el --- fill commands for Emacs 1;;; fill.el --- fill commands for Emacs
2 2
3;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2016 Free 3;; Copyright (C) 1985-1986, 1992, 1994-1997, 1999, 2001-2017 Free
4;; Software Foundation, Inc. 4;; Software Foundation, Inc.
5 5
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index bfe839ac77e..3a32b755349 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -1,6 +1,6 @@
1;;; flyspell.el --- On-the-fly spell checker -*- lexical-binding:t -*- 1;;; flyspell.el --- On-the-fly spell checker -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1998, 2000-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1998, 2000-2017 Free Software Foundation, Inc.
4 4
5;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr> 5;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr>
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 7551d2fde97..9747bd6cc12 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1,6 +1,6 @@
1;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 -*- lexical-binding:t -*- 1;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1994-1995, 1997-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1994-1995, 1997-2017 Free Software Foundation, Inc.
4 4
5;; Author: Ken Stevens <k.stevens@ieee.org> 5;; Author: Ken Stevens <k.stevens@ieee.org>
6;; Status : Release with 3.1.12+ and 3.2.0+ ispell. 6;; Status : Release with 3.1.12+ and 3.2.0+ ispell.
@@ -3133,7 +3133,14 @@ Must be called after `ispell-buffer-local-parsing' due to dependence on mode."
3133 (if (string= "" comment-end) "^" (regexp-quote comment-end))) 3133 (if (string= "" comment-end) "^" (regexp-quote comment-end)))
3134 (if (and (null ispell-check-comments) comment-start) 3134 (if (and (null ispell-check-comments) comment-start)
3135 (regexp-quote comment-start)) 3135 (regexp-quote comment-start))
3136 (ispell-begin-skip-region ispell-skip-region-alist) 3136 ;; If they set ispell-skip-region-alist to nil, mapconcat
3137 ;; will produce an empty string, which will then match
3138 ;; anything without moving point, something
3139 ;; ispell-skip-region doesn't expect. Perhaps we should be
3140 ;; more defensive and delq "" above as well, in addition to
3141 ;; deleting nil elements.
3142 (if ispell-skip-region-alist
3143 (ispell-begin-skip-region ispell-skip-region-alist))
3137 (ispell--make-filename-or-URL-re))) 3144 (ispell--make-filename-or-URL-re)))
3138 "\\|")) 3145 "\\|"))
3139 3146
diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el
index 16ce88dd83d..9edc759c2df 100644
--- a/lisp/textmodes/makeinfo.el
+++ b/lisp/textmodes/makeinfo.el
@@ -1,6 +1,6 @@
1;;; makeinfo.el --- run makeinfo conveniently 1;;; makeinfo.el --- run makeinfo conveniently
2 2
3;; Copyright (C) 1991, 1993, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1991, 1993, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Author: Robert J. Chassell 5;; Author: Robert J. Chassell
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index 35996bc2509..cea0c604baf 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -1,6 +1,6 @@
1;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source 1;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source
2 2
3;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2016 Free Software 3;; Copyright (C) 1985-1986, 1994-1995, 1997, 2001-2017 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
5 5
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index f67e85e8432..8542b951b3b 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -1,6 +1,6 @@
1;;; page-ext.el --- extended page handling commands 1;;; page-ext.el --- extended page handling commands
2 2
3;; Copyright (C) 1990-1991, 1993-1994, 2001-2016 Free Software 3;; Copyright (C) 1990-1991, 1993-1994, 2001-2017 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
5 5
6;; Author: Robert J. Chassell <bob@gnu.org> 6;; Author: Robert J. Chassell <bob@gnu.org>
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
index 22c73591b91..936896c3bd8 100644
--- a/lisp/textmodes/page.el
+++ b/lisp/textmodes/page.el
@@ -1,6 +1,6 @@
1;;; page.el --- page motion commands for Emacs 1;;; page.el --- page motion commands for Emacs
2 2
3;; Copyright (C) 1985, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Maintainer: emacs-devel@gnu.org 5;; Maintainer: emacs-devel@gnu.org
6;; Keywords: wp convenience 6;; Keywords: wp convenience
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index b7523ca9f43..f0671f489f8 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -1,6 +1,6 @@
1;;; paragraphs.el --- paragraph and sentence parsing 1;;; paragraphs.el --- paragraph and sentence parsing
2 2
3;; Copyright (C) 1985-1987, 1991, 1994-1997, 1999-2016 Free Software 3;; Copyright (C) 1985-1987, 1991, 1994-1997, 1999-2017 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
5 5
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 01d67b5c1dd..09d0a2f0a9a 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -1,6 +1,6 @@
1;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model 1;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model
2 2
3;; Copyright (C) 1985, 1994, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 1994, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Author: K. Shane Hartman 5;; Author: K. Shane Hartman
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el
index 926154364dc..822596c57c2 100644
--- a/lisp/textmodes/po.el
+++ b/lisp/textmodes/po.el
@@ -1,6 +1,6 @@
1;;; po.el --- basic support of PO translation files 1;;; po.el --- basic support of PO translation files
2 2
3;; Copyright (C) 1995-1998, 2000-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1995-1998, 2000-2017 Free Software Foundation, Inc.
4 4
5;; Authors: François Pinard <pinard@iro.umontreal.ca>, 5;; Authors: François Pinard <pinard@iro.umontreal.ca>,
6;; Greg McGary <gkm@magilla.cichlid.com>, 6;; Greg McGary <gkm@magilla.cichlid.com>,
diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el
index 46bf3c7552b..6b721260813 100644
--- a/lisp/textmodes/refbib.el
+++ b/lisp/textmodes/refbib.el
@@ -1,6 +1,6 @@
1;;; refbib.el --- convert refer-style references to ones usable by Latex bib 1;;; refbib.el --- convert refer-style references to ones usable by Latex bib
2 2
3;; Copyright (C) 1989, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1989, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Author: Henry Kautz <kautz@research.att.com> 5;; Author: Henry Kautz <kautz@research.att.com>
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index 4c9e62bb4c8..1843c8e9ede 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -1,6 +1,6 @@
1;;; refer.el --- look up references in bibliography files 1;;; refer.el --- look up references in bibliography files
2 2
3;; Copyright (C) 1992, 1996, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1992, 1996, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Author: Ashwin Ram <ashwin@cc.gatech.edu> 5;; Author: Ashwin Ram <ashwin@cc.gatech.edu>
6;; Maintainer: Gernot Heiser <gernot@acm.org> 6;; Maintainer: Gernot Heiser <gernot@acm.org>
diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el
index db0b0977b36..f65c9ade673 100644
--- a/lisp/textmodes/refill.el
+++ b/lisp/textmodes/refill.el
@@ -1,6 +1,6 @@
1;;; refill.el --- `auto-fill' by refilling paragraphs on changes 1;;; refill.el --- `auto-fill' by refilling paragraphs on changes
2 2
3;; Copyright (C) 2000-2016 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
4 4
5;; Author: Dave Love <fx@gnu.org> 5;; Author: Dave Love <fx@gnu.org>
6;; Maintainer: Miles Bader <miles@gnu.org> 6;; Maintainer: Miles Bader <miles@gnu.org>
diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el
index 8efe8a2ec19..1e0a5640483 100644
--- a/lisp/textmodes/reftex-auc.el
+++ b/lisp/textmodes/reftex-auc.el
@@ -1,6 +1,6 @@
1;;; reftex-auc.el --- RefTeX's interface to AUCTeX 1;;; reftex-auc.el --- RefTeX's interface to AUCTeX
2 2
3;; Copyright (C) 1997-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2017 Free Software Foundation, Inc.
4 4
5;; Author: Carsten Dominik <dominik@science.uva.nl> 5;; Author: Carsten Dominik <dominik@science.uva.nl>
6;; Maintainer: auctex-devel@gnu.org 6;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index fd7915ccc76..7f1887cbf45 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -1,6 +1,6 @@
1;;; reftex-cite.el --- creating citations with RefTeX 1;;; reftex-cite.el --- creating citations with RefTeX
2 2
3;; Copyright (C) 1997-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2017 Free Software Foundation, Inc.
4 4
5;; Author: Carsten Dominik <dominik@science.uva.nl> 5;; Author: Carsten Dominik <dominik@science.uva.nl>
6;; Maintainer: auctex-devel@gnu.org 6;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el
index 65742f36f78..16bc621f889 100644
--- a/lisp/textmodes/reftex-dcr.el
+++ b/lisp/textmodes/reftex-dcr.el
@@ -1,6 +1,6 @@
1;;; reftex-dcr.el --- viewing cross references and citations with RefTeX 1;;; reftex-dcr.el --- viewing cross references and citations with RefTeX
2 2
3;; Copyright (C) 1997-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2017 Free Software Foundation, Inc.
4 4
5;; Author: Carsten Dominik <dominik@science.uva.nl> 5;; Author: Carsten Dominik <dominik@science.uva.nl>
6;; Maintainer: auctex-devel@gnu.org 6;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el
index c8c62a0d944..91d2b485626 100644
--- a/lisp/textmodes/reftex-global.el
+++ b/lisp/textmodes/reftex-global.el
@@ -1,6 +1,6 @@
1;;; reftex-global.el --- operations on entire documents with RefTeX 1;;; reftex-global.el --- operations on entire documents with RefTeX
2 2
3;; Copyright (C) 1997-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2017 Free Software Foundation, Inc.
4 4
5;; Author: Carsten Dominik <dominik@science.uva.nl> 5;; Author: Carsten Dominik <dominik@science.uva.nl>
6;; Maintainer: auctex-devel@gnu.org 6;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index 4dd190d2b0f..6544029ef0c 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -1,6 +1,6 @@
1;;; reftex-index.el --- index support with RefTeX 1;;; reftex-index.el --- index support with RefTeX
2 2
3;; Copyright (C) 1997-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2017 Free Software Foundation, Inc.
4 4
5;; Author: Carsten Dominik <dominik@science.uva.nl> 5;; Author: Carsten Dominik <dominik@science.uva.nl>
6;; Maintainer: auctex-devel@gnu.org 6;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index 9180bea3d3b..af2810d72e8 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -1,6 +1,6 @@
1;;; reftex-parse.el --- parser functions for RefTeX 1;;; reftex-parse.el --- parser functions for RefTeX
2 2
3;; Copyright (C) 1997-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2017 Free Software Foundation, Inc.
4 4
5;; Author: Carsten Dominik <dominik@science.uva.nl> 5;; Author: Carsten Dominik <dominik@science.uva.nl>
6;; Maintainer: auctex-devel@gnu.org 6;; Maintainer: auctex-devel@gnu.org
@@ -270,7 +270,10 @@ of master file."
270 (when (eq (char-before) ?\\) (backward-char)) 270 (when (eq (char-before) ?\\) (backward-char))
271 ;; Insert in List 271 ;; Insert in List
272 (setq toc-entry (funcall reftex-section-info-function file)) 272 (setq toc-entry (funcall reftex-section-info-function file))
273 (when toc-entry 273 (when (and toc-entry
274 (eq ;; Either both are t or both are nil.
275 (= (char-after bound) ?%)
276 (string-suffix-p ".dtx" file)))
274 ;; It can happen that section info returns nil 277 ;; It can happen that section info returns nil
275 (setq level (nth 5 toc-entry)) 278 (setq level (nth 5 toc-entry))
276 (setq highest-level (min highest-level level)) 279 (setq highest-level (min highest-level level))
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index fdde4aa0541..dd183548d0f 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -1,6 +1,6 @@
1;;; reftex-ref.el --- code to create labels and references with RefTeX 1;;; reftex-ref.el --- code to create labels and references with RefTeX
2 2
3;; Copyright (C) 1997-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2017 Free Software Foundation, Inc.
4 4
5;; Author: Carsten Dominik <dominik@science.uva.nl> 5;; Author: Carsten Dominik <dominik@science.uva.nl>
6;; Maintainer: auctex-devel@gnu.org 6;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el
index d3a7ee49804..a4533adec08 100644
--- a/lisp/textmodes/reftex-sel.el
+++ b/lisp/textmodes/reftex-sel.el
@@ -1,6 +1,6 @@
1;;; reftex-sel.el --- the selection modes for RefTeX 1;;; reftex-sel.el --- the selection modes for RefTeX
2 2
3;; Copyright (C) 1997-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2017 Free Software Foundation, Inc.
4 4
5;; Author: Carsten Dominik <dominik@science.uva.nl> 5;; Author: Carsten Dominik <dominik@science.uva.nl>
6;; Maintainer: auctex-devel@gnu.org 6;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index a4c8da07501..ab49ae8e320 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -1,6 +1,6 @@
1;;; reftex-toc.el --- RefTeX's table of contents mode 1;;; reftex-toc.el --- RefTeX's table of contents mode
2 2
3;; Copyright (C) 1997-2000, 2003-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2000, 2003-2017 Free Software Foundation, Inc.
4 4
5;; Author: Carsten Dominik <dominik@science.uva.nl> 5;; Author: Carsten Dominik <dominik@science.uva.nl>
6;; Maintainer: auctex-devel@gnu.org 6;; Maintainer: auctex-devel@gnu.org
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index d6de53b2466..63abd048e9d 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -1,6 +1,6 @@
1;;; reftex-vars.el --- configuration variables for RefTeX 1;;; reftex-vars.el --- configuration variables for RefTeX
2 2
3;; Copyright (C) 1997-1999, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-1999, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Author: Carsten Dominik <dominik@science.uva.nl> 5;; Author: Carsten Dominik <dominik@science.uva.nl>
6;; Maintainer: auctex-devel@gnu.org 6;; Maintainer: auctex-devel@gnu.org
@@ -151,6 +151,22 @@ distribution. Mixed-case symbols are convenience aliases.")
151 (?A . "\\citeauthor*{%l}") 151 (?A . "\\citeauthor*{%l}")
152 (?y . "\\citeyear{%l}") 152 (?y . "\\citeyear{%l}")
153 (?n . "\\nocite{%l}"))) 153 (?n . "\\nocite{%l}")))
154 (biblatex "The Biblatex package"
155 ((?\C-m . "\\cite[][]{%l}")
156 (?C . "\\cite*[][]{%l}")
157 (?t . "\\textcite[][]{%l}")
158 (?T . "\\textcite*[][]{%l}")
159 (?p . "\\parencite[][]{%l}")
160 (?P . "\\parencite*[][]{%l}")
161 (?f . "\\footcite[][]{%l}")
162 (?s . "\\smartcite[][]{%l}")
163 (?u . "\\autocite[][]{%l}")
164 (?U . "\\autocite*[][]{%l}")
165 (?a . "\\citeauthor{%l}")
166 (?A . "\\citeauthor*{%l}")
167 (?y . "\\citeyear{%l}")
168 (?Y . "\\citeyear*{%l}")
169 (?n . "\\nocite{%l}")))
154 (amsrefs "The AMSRefs package" 170 (amsrefs "The AMSRefs package"
155 ((?\C-m . "\\cite{%l}") 171 ((?\C-m . "\\cite{%l}")
156 (?p . "\\cite{%l}") 172 (?p . "\\cite{%l}")
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index adc5076daf1..18b35981f82 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -1,5 +1,5 @@
1;;; reftex.el --- minor mode for doing \label, \ref, \cite, \index in LaTeX 1;;; reftex.el --- minor mode for doing \label, \ref, \cite, \index in LaTeX
2;; Copyright (C) 1997-2000, 2003-2016 Free Software Foundation, Inc. 2;; Copyright (C) 1997-2000, 2003-2017 Free Software Foundation, Inc.
3 3
4;; Author: Carsten Dominik <dominik@science.uva.nl> 4;; Author: Carsten Dominik <dominik@science.uva.nl>
5;; Maintainer: auctex-devel@gnu.org 5;; Maintainer: auctex-devel@gnu.org
@@ -1015,8 +1015,8 @@ This enforces rescanning the buffer on next use."
1015 ;; Calculate the regular expressions 1015 ;; Calculate the regular expressions
1016 (let* ( 1016 (let* (
1017; (wbol "\\(\\`\\|[\n\r]\\)[ \t]*") 1017; (wbol "\\(\\`\\|[\n\r]\\)[ \t]*")
1018 (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because 1018 (wbol "\\(^\\)%?[ \t]*") ; Need to keep the empty group because
1019 ; match numbers are hard coded 1019 ; match numbers are hard coded
1020 (label-re (concat "\\(?:" 1020 (label-re (concat "\\(?:"
1021 (mapconcat 'identity reftex-label-regexps "\\|") 1021 (mapconcat 'identity reftex-label-regexps "\\|")
1022 "\\)")) 1022 "\\)"))
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 99d34ad0da5..388e49cfdc2 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -1,6 +1,6 @@
1;;; remember --- a mode for quickly jotting down things to remember 1;;; remember --- a mode for quickly jotting down things to remember
2 2
3;; Copyright (C) 1999-2001, 2003-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1999-2001, 2003-2017 Free Software Foundation, Inc.
4 4
5;; Author: John Wiegley <johnw@gnu.org> 5;; Author: John Wiegley <johnw@gnu.org>
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 7161dd329ac..261e98eabce 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -1,6 +1,6 @@
1;;; rst.el --- Mode for viewing and editing reStructuredText-documents. 1;;; rst.el --- Mode for viewing and editing reStructuredText-documents -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2003-2016 Free Software Foundation, Inc. 3;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
4 4
5;; Maintainer: Stefan Merten <stefan at merten-home dot de> 5;; Maintainer: Stefan Merten <stefan at merten-home dot de>
6;; Author: Stefan Merten <stefan at merten-home dot de>, 6;; Author: Stefan Merten <stefan at merten-home dot de>,
@@ -100,15 +100,30 @@
100 100
101;; FIXME: Check through major mode conventions again. 101;; FIXME: Check through major mode conventions again.
102 102
103;; FIXME: Add proper ";;;###autoload" comments.
104
105;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*-
106;; lexical-binding: t -*-" in the first line.
107
108;; FIXME: Embed complicated `defconst's in `eval-when-compile'. 103;; FIXME: Embed complicated `defconst's in `eval-when-compile'.
109 104
110;; FIXME: Use `testcover'. Mark up a function with sufficient test coverage by 105;; Common Lisp stuff
111;; a comment tagged with `testcover' after the `defun'. 106(require 'cl-lib)
107
108;; Correct wrong declaration.
109(def-edebug-spec push
110 (&or [form symbolp] [form gv-place]))
111
112;; Correct wrong declaration. This still doesn't support dotted destructuring
113;; though.
114(def-edebug-spec cl-lambda-list
115 (([&rest cl-macro-arg]
116 [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
117 [&optional ["&rest" arg]]
118 [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
119 &optional "&allow-other-keys"]]
120 [&optional ["&aux" &rest
121 &or (symbolp &optional def-form) symbolp]]
122 )))
123
124;; Add missing declaration.
125(def-edebug-spec cl-type-spec sexp) ;; This is not exactly correct but good
126 ;; enough.
112 127
113;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 128;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
114;; Support for `testcover' 129;; Support for `testcover'
@@ -129,9 +144,9 @@ considered constants. Revert it with this function after each `defcustom'."
129 (setq testcover-module-constants 144 (setq testcover-module-constants
130 (delq nil 145 (delq nil
131 (mapcar 146 (mapcar
132 (lambda (sym) 147 #'(lambda (sym)
133 (if (not (plist-member (symbol-plist sym) 'standard-value)) 148 (if (not (plist-member (symbol-plist sym) 'standard-value))
134 sym)) 149 sym))
135 testcover-module-constants))))) 150 testcover-module-constants)))))
136 151
137(defun rst-testcover-add-compose (fun) 152(defun rst-testcover-add-compose (fun)
@@ -144,69 +159,72 @@ considered constants. Revert it with this function after each `defcustom'."
144 (when (boundp 'testcover-1value-functions) 159 (when (boundp 'testcover-1value-functions)
145 (add-to-list 'testcover-1value-functions fun))) 160 (add-to-list 'testcover-1value-functions fun)))
146 161
162
147;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 163;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
148;; Common Lisp stuff 164;; Helpers.
149 165
150;; Only use of macros is allowed - may be replaced by `cl-lib' some time. 166(cl-defmacro rst-destructuring-dolist
151(eval-when-compile 167 ((arglist list &optional result) &rest body)
152 (require 'cl)) 168 "`cl-dolist' with destructuring of the list elements.
153 169ARGLIST is a Common List argument list which may include
154;; Redefine some functions from `cl.el' in a proper namespace until they may be 170destructuring. LIST, RESULT and BODY are as for `cl-dolist'.
155;; used from there. 171Note that definitions in ARGLIST are visible only in the BODY and
156 172neither in RESULT nor in LIST."
157(defun rst-signum (x) 173 ;; FIXME: It would be very useful if the definitions in ARGLIST would be
174 ;; visible in RESULT. But may be this is rather a
175 ;; `rst-destructuring-do' then.
176 (declare (debug
177 (&define ([&or symbolp cl-macro-list] def-form &optional def-form)
178 cl-declarations def-body))
179 (indent 1))
180 (let ((var (make-symbol "--rst-destructuring-dolist-var--")))
181 `(cl-dolist (,var ,list ,result)
182 (cl-destructuring-bind ,arglist ,var
183 ,@body))))
184
185(defun rst-forward-line-strict (n &optional limit)
158 ;; testcover: ok. 186 ;; testcover: ok.
159 "Return 1 if X is positive, -1 if negative, 0 if zero." 187 "Try to move point to beginning of line I + N where I is the current line.
160 (cond 188Return t if movement is successful. Otherwise don't move point
161 ((> x 0) 1) 189and return nil. If a position is given by LIMIT, movement
162 ((< x 0) -1) 190happened but the following line is missing and thus its beginning
163 (t 0))) 191can not be reached but the movement reached at least LIMIT
164 192consider this a successful movement. LIMIT is ignored in other
165(defun rst-some (seq &optional pred) 193cases."
166 ;; testcover: ok. 194 (let ((start (point)))
167 "Return non-nil if any element of SEQ yields non-nil when PRED is applied. 195 (if (and (zerop (forward-line n))
168Apply PRED to each element of list SEQ until the first non-nil 196 (or (bolp)
169result is yielded and return this result. PRED defaults to 197 (and limit
170`identity'." 198 (>= (point) limit))))
171 (unless pred 199 t
172 (setq pred 'identity)) 200 (goto-char start)
173 (catch 'rst-some 201 nil)))
174 (dolist (elem seq) 202
175 (let ((r (funcall pred elem))) 203(defun rst-forward-line-looking-at (n rst-re-args &optional fun)
176 (when r
177 (throw 'rst-some r))))))
178
179(defun rst-position-if (pred seq)
180 ;; testcover: ok.
181 "Return position of first element satisfying PRED in list SEQ or nil."
182 (catch 'rst-position-if
183 (let ((i 0))
184 (dolist (elem seq)
185 (when (funcall pred elem)
186 (throw 'rst-position-if i))
187 (incf i)))))
188
189(defun rst-position (elem seq)
190 ;; testcover: ok. 204 ;; testcover: ok.
191 "Return position of ELEM in list SEQ or nil. 205 "Move forward N lines and if successful check whether RST-RE-ARGS is matched.
192Comparison done with `equal'." 206Moving forward is done by `rst-forward-line-strict'. RST-RE-ARGS
193 ;; Create a closure containing `elem' so the `lambda' always sees our 207is a single or a list of arguments for `rst-re'. FUN is a
194 ;; parameter instead of an `elem' which may be in dynamic scope at the time 208function defaulting to `identity' which is called after the call
195 ;; of execution of the `lambda'. 209to `looking-at' receiving its return value as the first argument.
196 (lexical-let ((elem elem)) 210When FUN is called match data is just set by `looking-at' and
197 (rst-position-if (function (lambda (e) 211point is at the beginning of the line. Return nil if moving
198 (equal elem e))) 212forward failed or otherwise the return value of FUN. Preserve
199 seq))) 213global match data, point, mark and current buffer."
200 214 (unless (listp rst-re-args)
201(defun rst-member-if (pred seq) 215 (setq rst-re-args (list rst-re-args)))
202 ;; testcover: ok. 216 (unless fun
203 "Return sublist of SEQ starting with the element whose car satisfies PRED." 217 (setq fun #'identity))
204 (let (found) 218 (save-match-data
205 (while (and (not found) seq) 219 (save-excursion
206 (if (funcall pred (car seq)) 220 (when (rst-forward-line-strict n)
207 (setq found seq) 221 (funcall fun (looking-at (apply #'rst-re rst-re-args)))))))
208 (setq seq (cdr seq)))) 222
209 found)) 223(rst-testcover-add-1value 'rst-delete-entire-line)
224(defun rst-delete-entire-line (n)
225 "Move N lines and delete the entire line."
226 (delete-region (line-beginning-position (+ n 1))
227 (line-beginning-position (+ n 2))))
210 228
211 229
212;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 230;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -226,7 +244,7 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
226;; Use CVSHeader to really get information from CVS and not other version 244;; Use CVSHeader to really get information from CVS and not other version
227;; control systems. 245;; control systems.
228(defconst rst-cvs-header 246(defconst rst-cvs-header
229 "$CVSHeader: sm/rst_el/rst.el,v 1.600 2016/07/31 11:13:44 stefan Exp $") 247 "$CVSHeader: sm/rst_el/rst.el,v 1.1058.2.9 2017/01/08 09:54:50 stefan Exp $")
230(defconst rst-cvs-rev 248(defconst rst-cvs-rev
231 (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" 249 (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+"
232 " .*" rst-cvs-header "0.0") 250 " .*" rst-cvs-header "0.0")
@@ -240,22 +258,22 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
240;; Use LastChanged... to really get information from SVN. 258;; Use LastChanged... to really get information from SVN.
241(defconst rst-svn-rev 259(defconst rst-svn-rev
242 (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " " 260 (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " "
243 "$LastChangedRevision: 7963 $") 261 "$LastChangedRevision: 8015 $")
244 "The SVN revision of this file. 262 "The SVN revision of this file.
245SVN revision is the upstream (docutils) revision.") 263SVN revision is the upstream (docutils) revision.")
246(defconst rst-svn-timestamp 264(defconst rst-svn-timestamp
247 (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " " 265 (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " "
248 "$LastChangedDate: 2016-07-31 13:13:21 +0200 (Sun, 31 Jul 2016) $") 266 "$LastChangedDate: 2017-01-08 10:54:35 +0100 (Sun, 08 Jan 2017) $")
249 "The SVN time stamp of this file.") 267 "The SVN time stamp of this file.")
250 268
251;; Maintained by the release process. 269;; Maintained by the release process.
252(defconst rst-official-version 270(defconst rst-official-version
253 (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " 271 (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
254 "%OfficialVersion: 1.5.0 %") 272 "%OfficialVersion: 1.5.2 %")
255 "Official version of the package.") 273 "Official version of the package.")
256(defconst rst-official-cvs-rev 274(defconst rst-official-cvs-rev
257 (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " 275 (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
258 "%Revision: 1.600 %") 276 "$Revision: 1.1058.2.9 $")
259 "CVS revision of this file in the official version.") 277 "CVS revision of this file in the official version.")
260 278
261(defconst rst-version 279(defconst rst-version
@@ -278,6 +296,9 @@ in parentheses follows the development revision and the time stamp.")
278 ("1.4.1" . "24.5") 296 ("1.4.1" . "24.5")
279 ("1.4.2" . "24.5") 297 ("1.4.2" . "24.5")
280 ("1.5.0" . "26.1") 298 ("1.5.0" . "26.1")
299 ("1.5.1" . "26.2")
300 ("1.5.2" . "26.2")
301 ;; Whatever the Emacs version is this rst.el version ends up in.
281 )) 302 ))
282 303
283(unless (assoc rst-official-version rst-package-emacs-version-alist) 304(unless (assoc rst-official-version rst-package-emacs-version-alist)
@@ -368,6 +389,7 @@ in parentheses follows the development revision and the time stamp.")
368 389
369 ;; Various starts 390 ;; Various starts
370 (bul-sta bul-tag bli-sfx) ; Start of a bulleted item. 391 (bul-sta bul-tag bli-sfx) ; Start of a bulleted item.
392 (bul-beg lin-beg bul-sta) ; A bullet item at the beginning of a line.
371 393
372 ;; Explicit markup tag (`exm') 394 ;; Explicit markup tag (`exm')
373 (exm-tag "\\.\\.") 395 (exm-tag "\\.\\.")
@@ -571,34 +593,34 @@ referenceable group (\"\\(...\\)\").
571 593
572After interpretation of ARGS the results are concatenated as for 594After interpretation of ARGS the results are concatenated as for
573`:seq'." 595`:seq'."
574 (apply 'concat 596 (apply #'concat
575 (mapcar 597 (mapcar
576 (lambda (re) 598 #'(lambda (re)
577 (cond 599 (cond
578 ((stringp re) 600 ((stringp re)
579 re) 601 re)
580 ((symbolp re) 602 ((symbolp re)
581 (cadr (assoc re rst-re-alist))) 603 (cadr (assoc re rst-re-alist)))
582 ((characterp re) 604 ((characterp re)
583 (regexp-quote (char-to-string re))) 605 (regexp-quote (char-to-string re)))
584 ((listp re) 606 ((listp re)
585 (let ((nested 607 (let ((nested
586 (mapcar (lambda (elt) 608 (mapcar (lambda (elt)
587 (rst-re elt)) 609 (rst-re elt))
588 (cdr re)))) 610 (cdr re))))
589 (cond 611 (cond
590 ((eq (car re) :seq) 612 ((eq (car re) :seq)
591 (mapconcat 'identity nested "")) 613 (mapconcat #'identity nested ""))
592 ((eq (car re) :shy) 614 ((eq (car re) :shy)
593 (concat "\\(?:" (mapconcat 'identity nested "") "\\)")) 615 (concat "\\(?:" (mapconcat #'identity nested "") "\\)"))
594 ((eq (car re) :grp) 616 ((eq (car re) :grp)
595 (concat "\\(" (mapconcat 'identity nested "") "\\)")) 617 (concat "\\(" (mapconcat #'identity nested "") "\\)"))
596 ((eq (car re) :alt) 618 ((eq (car re) :alt)
597 (concat "\\(?:" (mapconcat 'identity nested "\\|") "\\)")) 619 (concat "\\(?:" (mapconcat #'identity nested "\\|") "\\)"))
598 (t 620 (t
599 (error "Unknown list car: %s" (car re)))))) 621 (error "Unknown list car: %s" (car re))))))
600 (t 622 (t
601 (error "Unknown object type for building regex: %s" re)))) 623 (error "Unknown object type for building regex: %s" re))))
602 args))) 624 args)))
603 625
604;; FIXME: Remove circular dependency between `rst-re' and `rst-re-alist'. 626;; FIXME: Remove circular dependency between `rst-re' and `rst-re-alist'.
@@ -610,7 +632,7 @@ After interpretation of ARGS the results are concatenated as for
610 (dolist (re rst-re-alist-def rst-re-alist) 632 (dolist (re rst-re-alist-def rst-re-alist)
611 (setq rst-re-alist 633 (setq rst-re-alist
612 (nconc rst-re-alist 634 (nconc rst-re-alist
613 (list (list (car re) (apply 'rst-re (cdr re)))))))) 635 (list (list (car re) (apply #'rst-re (cdr re))))))))
614 "Alist mapping symbols from `rst-re-alist-def' to regex strings.")) 636 "Alist mapping symbols from `rst-re-alist-def' to regex strings."))
615 637
616 638
@@ -630,9 +652,9 @@ After interpretation of ARGS the results are concatenated as for
630;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 652;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
631;; Class rst-Ado 653;; Class rst-Ado
632 654
633(defstruct 655(cl-defstruct
634 (rst-Ado 656 (rst-Ado
635 (:constructor nil) ;; Prevent creating unchecked values. 657 (:constructor nil) ; Prevent creating unchecked values.
636 ;; Construct a transition. 658 ;; Construct a transition.
637 (:constructor 659 (:constructor
638 rst-Ado-new-transition 660 rst-Ado-new-transition
@@ -682,61 +704,45 @@ This type is immutable."
682 ;; testcover: ok. 704 ;; testcover: ok.
683 "Validate CHAR to be a valid adornment character. 705 "Validate CHAR to be a valid adornment character.
684Return CHAR if so or signal an error otherwise." 706Return CHAR if so or signal an error otherwise."
685 (cond 707 (cl-check-type char character)
686 ((not (characterp char)) 708 (cl-check-type char (satisfies
687 (signal 'wrong-type-argument (list 'characterp char))) 709 (lambda (c)
688 ((memq char rst-adornment-chars) 710 (memq c rst-adornment-chars)))
689 char) 711 "Character must be a valid adornment character")
690 (t 712 char)
691 (signal 'args-out-of-range
692 (list (format
693 "Character must be a valid adornment character, not '%s'"
694 char))))))
695 713
696;; Public methods 714;; Public methods
697 715
698(defun rst-Ado-is-transition (self) 716(defun rst-Ado-is-transition (self)
699 ;; testcover: ok. 717 ;; testcover: ok.
700 "Return non-nil if SELF is a transition adornment." 718 "Return non-nil if SELF is a transition adornment."
701 (unless (rst-Ado-p self) 719 (cl-check-type self rst-Ado)
702 (signal 'wrong-type-argument
703 (list 'rst-Ado-p self)))
704 (eq (rst-Ado--style self) 'transition)) 720 (eq (rst-Ado--style self) 'transition))
705 721
706(defun rst-Ado-is-section (self) 722(defun rst-Ado-is-section (self)
707 ;; testcover: ok. 723 ;; testcover: ok.
708 "Return non-nil if SELF is a section adornment." 724 "Return non-nil if SELF is a section adornment."
709 (unless (rst-Ado-p self) 725 (cl-check-type self rst-Ado)
710 (signal 'wrong-type-argument
711 (list 'rst-Ado-p self)))
712 (not (rst-Ado-is-transition self))) 726 (not (rst-Ado-is-transition self)))
713 727
714(defun rst-Ado-is-simple (self) 728(defun rst-Ado-is-simple (self)
715 ;; testcover: ok. 729 ;; testcover: ok.
716 "Return non-nil if SELF is a simple section adornment." 730 "Return non-nil if SELF is a simple section adornment."
717 (unless (rst-Ado-p self) 731 (cl-check-type self rst-Ado)
718 (signal 'wrong-type-argument
719 (list 'rst-Ado-p self)))
720 (eq (rst-Ado--style self) 'simple)) 732 (eq (rst-Ado--style self) 'simple))
721 733
722(defun rst-Ado-is-over-and-under (self) 734(defun rst-Ado-is-over-and-under (self)
723 ;; testcover: ok. 735 ;; testcover: ok.
724 "Return non-nil if SELF is a over-and-under section adornment." 736 "Return non-nil if SELF is a over-and-under section adornment."
725 (unless (rst-Ado-p self) 737 (cl-check-type self rst-Ado)
726 (signal 'wrong-type-argument
727 (list 'rst-Ado-p self)))
728 (eq (rst-Ado--style self) 'over-and-under)) 738 (eq (rst-Ado--style self) 'over-and-under))
729 739
730(defun rst-Ado-equal (self other) 740(defun rst-Ado-equal (self other)
731 ;; testcover: ok. 741 ;; testcover: ok.
732 "Return non-nil when SELF and OTHER are equal." 742 "Return non-nil when SELF and OTHER are equal."
743 (cl-check-type self rst-Ado)
744 (cl-check-type other rst-Ado)
733 (cond 745 (cond
734 ((not (rst-Ado-p self))
735 (signal 'wrong-type-argument
736 (list 'rst-Ado-p self)))
737 ((not (rst-Ado-p other))
738 (signal 'wrong-type-argument
739 (list 'rst-Ado-p other)))
740 ((not (eq (rst-Ado--style self) (rst-Ado--style other))) 746 ((not (eq (rst-Ado--style self) (rst-Ado--style other)))
741 nil) 747 nil)
742 ((rst-Ado-is-transition self)) 748 ((rst-Ado-is-transition self))
@@ -744,22 +750,19 @@ Return CHAR if so or signal an error otherwise."
744 750
745(defun rst-Ado-position (self ados) 751(defun rst-Ado-position (self ados)
746 ;; testcover: ok. 752 ;; testcover: ok.
747 "Return position of of SELF in ADOS or nil." 753 "Return position of SELF in ADOS or nil."
748 (unless (rst-Ado-p self) 754 (cl-check-type self rst-Ado)
749 (signal 'wrong-type-argument 755 (cl-position-if #'(lambda (e)
750 (list 'rst-Ado-p self))) 756 (rst-Ado-equal self e))
751 (lexical-let ((ado self)) ;; Create closure. 757 ados))
752 (rst-position-if (function (lambda (e)
753 (rst-Ado-equal ado e)))
754 ados)))
755 758
756 759
757;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 760;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
758;; Class rst-Hdr 761;; Class rst-Hdr
759 762
760(defstruct 763(cl-defstruct
761 (rst-Hdr 764 (rst-Hdr
762 (:constructor nil) ;; Prevent creating unchecked values. 765 (:constructor nil) ; Prevent creating unchecked values.
763 ;; Construct while all parameters must be valid. 766 ;; Construct while all parameters must be valid.
764 (:constructor 767 (:constructor
765 rst-Hdr-new 768 rst-Hdr-new
@@ -784,7 +787,7 @@ Return CHAR if so or signal an error otherwise."
784 &aux 787 &aux
785 (ado (rst-Hdr--validate-ado (rst-Ado-new-invert ado-arg))) 788 (ado (rst-Hdr--validate-ado (rst-Ado-new-invert ado-arg)))
786 (indent (rst-Hdr--validate-indent indent-arg ado t)))) 789 (indent (rst-Hdr--validate-indent indent-arg ado t))))
787 (:copier rst-Hdr-copy)) ;; Not really needed for an immutable type. 790 (:copier nil)) ; Not really needed for an immutable type.
788 "Representation of reStructuredText section header characteristics. 791 "Representation of reStructuredText section header characteristics.
789 792
790This type is immutable." 793This type is immutable."
@@ -800,10 +803,8 @@ This type is immutable."
800 "Validate INDENT to be a valid indentation for ADO. 803 "Validate INDENT to be a valid indentation for ADO.
801Return INDENT if so or signal an error otherwise. If LAX don't 804Return INDENT if so or signal an error otherwise. If LAX don't
802signal an error and return a valid indent." 805signal an error and return a valid indent."
806 (cl-check-type indent integer)
803 (cond 807 (cond
804 ((not (integerp indent))
805 (signal 'wrong-type-argument
806 (list 'integerp 'null indent)))
807 ((zerop indent) 808 ((zerop indent)
808 indent) 809 indent)
809 ((rst-Ado-is-simple ado) 810 ((rst-Ado-is-simple ado)
@@ -816,33 +817,34 @@ signal an error and return a valid indent."
816 0 817 0
817 (signal 'args-out-of-range 818 (signal 'args-out-of-range
818 '("Indentation must not be negative")))) 819 '("Indentation must not be negative"))))
819 (indent))) ;; Implicitly over-and-under. 820 ;; Implicitly over-and-under.
821 (indent)))
820 822
821(defun rst-Hdr--validate-ado (ado) 823(defun rst-Hdr--validate-ado (ado)
822 ;; testcover: ok. 824 ;; testcover: ok.
823 "Validate ADO to be a valid adornment. 825 "Validate ADO to be a valid adornment.
824Return ADO if so or signal an error otherwise." 826Return ADO if so or signal an error otherwise."
827 (cl-check-type ado rst-Ado)
825 (cond 828 (cond
826 ((not (rst-Ado-p ado))
827 (signal 'wrong-type-argument
828 (list 'rst-Ado-p ado)))
829 ((rst-Ado-is-transition ado) 829 ((rst-Ado-is-transition ado)
830 (signal 'args-out-of-range 830 (signal 'args-out-of-range
831 '("Adornment for header must not be transition."))) 831 '("Adornment for header must not be transition.")))
832 (t 832 (ado)))
833 ado)))
834 833
835;; Public class methods 834;; Public class methods
836 835
836(defvar rst-preferred-adornments) ; Forward declaration.
837
837(defun rst-Hdr-preferred-adornments () 838(defun rst-Hdr-preferred-adornments ()
838 ;; testcover: ok. 839 ;; testcover: ok.
839 "Return preferred adornments as list of `rst-Hdr'." 840 "Return preferred adornments as list of `rst-Hdr'."
840 (mapcar (lambda (el) 841 (mapcar (cl-function
841 (rst-Hdr-new-lax 842 (lambda ((character style indent))
842 (if (eq (cadr el) 'over-and-under) 843 (rst-Hdr-new-lax
843 (rst-Ado-new-over-and-under (car el)) 844 (if (eq style 'over-and-under)
844 (rst-Ado-new-simple (car el))) 845 (rst-Ado-new-over-and-under character)
845 (caddr el))) 846 (rst-Ado-new-simple character))
847 indent)))
846 rst-preferred-adornments)) 848 rst-preferred-adornments))
847 849
848;; Public methods 850;; Public methods
@@ -850,238 +852,238 @@ Return ADO if so or signal an error otherwise."
850(defun rst-Hdr-member-ado (self hdrs) 852(defun rst-Hdr-member-ado (self hdrs)
851 ;; testcover: ok. 853 ;; testcover: ok.
852 "Return sublist of HDRS whose car's adornment equals that of SELF or nil." 854 "Return sublist of HDRS whose car's adornment equals that of SELF or nil."
853 (unless (rst-Hdr-p self) 855 (cl-check-type self rst-Hdr)
854 (signal 'wrong-type-argument 856 (let ((ado (rst-Hdr-ado self)))
855 (list 'rst-Hdr-p self))) 857 (cl-member-if #'(lambda (hdr)
856 (let ((pos (rst-Ado-position (rst-Hdr-ado self) (rst-Hdr-ado-map hdrs)))) 858 (rst-Ado-equal ado (rst-Hdr-ado hdr)))
857 (and pos (nthcdr pos hdrs)))) 859 hdrs)))
858 860
859(defun rst-Hdr-ado-map (selves) 861(defun rst-Hdr-ado-map (selves)
860 ;; testcover: ok. 862 ;; testcover: ok.
861 "Return `rst-Ado' list extracted from elements of SELVES." 863 "Return `rst-Ado' list extracted from elements of SELVES."
862 (mapcar 'rst-Hdr-ado selves)) 864 (mapcar #'rst-Hdr-ado selves))
863 865
864(defun rst-Hdr-get-char (self) 866(defun rst-Hdr-get-char (self)
865 ;; testcover: ok. 867 ;; testcover: ok.
866 "Return character of the adornment of SELF." 868 "Return character of the adornment of SELF."
867 (unless (rst-Hdr-p self) 869 (cl-check-type self rst-Hdr)
868 (signal 'wrong-type-argument
869 (list 'rst-Hdr-p self)))
870 (rst-Ado-char (rst-Hdr-ado self))) 870 (rst-Ado-char (rst-Hdr-ado self)))
871 871
872(defun rst-Hdr-is-over-and-under (self) 872(defun rst-Hdr-is-over-and-under (self)
873 ;; testcover: ok. 873 ;; testcover: ok.
874 "Return non-nil if SELF is a over-and-under section header." 874 "Return non-nil if SELF is a over-and-under section header."
875 (unless (rst-Hdr-p self) 875 (cl-check-type self rst-Hdr)
876 (signal 'wrong-type-argument
877 (list 'rst-Hdr-p self)))
878 (rst-Ado-is-over-and-under (rst-Hdr-ado self))) 876 (rst-Ado-is-over-and-under (rst-Hdr-ado self)))
879 877
880 878
881;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 879;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
882;; Class rst-Ttl 880;; Class rst-Ttl
883 881
884(defstruct 882(cl-defstruct
885 (rst-Ttl 883 (rst-Ttl
886 (:constructor nil) ;; Prevent creating unchecked values. 884 (:constructor nil) ; Prevent creating unchecked values.
887 ;; Construct with valid parameters for all attributes. 885 ;; Construct with valid parameters for all attributes.
888 (:constructor 886 (:constructor ; Private constructor
889 rst-Ttl-new 887 rst-Ttl--new
890 (ado-arg 888 (ado-arg
891 match-arg 889 match-arg
892 indent-arg 890 indent-arg
893 text-arg 891 text-arg
894 &optional
895 hdr-arg
896 level-arg
897 &aux 892 &aux
898 (ado (rst-Ttl--validate-ado ado-arg)) 893 (ado (rst-Ttl--validate-ado ado-arg))
899 (match (rst-Ttl--validate-match match-arg ado)) 894 (match (rst-Ttl--validate-match match-arg ado))
900 (indent (rst-Ttl--validate-indent indent-arg ado)) 895 (indent (rst-Ttl--validate-indent indent-arg ado))
901 (text (rst-Ttl--validate-text text-arg ado)) 896 (text (rst-Ttl--validate-text text-arg ado))
902 (hdr (and hdr-arg (rst-Ttl--validate-hdr hdr-arg ado indent))) 897 (hdr (condition-case nil
903 (level (and level-arg (rst-Ttl--validate-level level-arg))))) 898 (rst-Hdr-new ado indent)
904 (:copier rst-Ttl-copy)) 899 (error nil)))))
905 "Representation of a reStructuredText section header as found in the buffer. 900 (:copier nil)) ; Not really needed for an immutable type.
906This type gathers information about an adorned part in the 901 "Representation of a reStructuredText section header as found in a buffer.
907buffer. Thus only the basic attributes are immutable. Although 902This type gathers information about an adorned part in the buffer.
908the remaining attributes are `setf'-able the respective setters 903
909should be used." 904This type is immutable."
910 ;; The adornment characteristics or nil for a title candidate. 905 ;; The adornment characteristics or nil for a title candidate.
911 (ado nil :read-only t) 906 (ado nil :read-only t)
912 ;; The match-data for `ado' as returned by `match-data'. Match group 0 907 ;; The match-data for `ado' in a form similarly returned by `match-data' (but
913 ;; matches the whole construct. Match group 1 matches the overline adornment 908 ;; not necessarily with markers in buffers). Match group 0 matches the whole
914 ;; if present. Match group 2 matches the section title text or the 909 ;; construct. Match group 1 matches the overline adornment if present.
915 ;; transition. Match group 3 matches the underline adornment. 910 ;; Match group 2 matches the section title text or the transition. Match
911 ;; group 3 matches the underline adornment.
916 (match nil :read-only t) 912 (match nil :read-only t)
917 ;; An indentation found for the title line or nil for a transition. 913 ;; An indentation found for the title line or nil for a transition.
918 (indent nil :read-only t) 914 (indent nil :read-only t)
919 ;; The text of the title or nil for a transition. 915 ;; The text of the title or nil for a transition.
920 (text nil :read-only t) 916 (text nil :read-only t)
921 ;; The header characteristics if it is a valid section header. 917 ;; The header characteristics if it is a valid section header.
922 (hdr nil) 918 (hdr nil :read-only t)
923 ;; The hierarchical level of the section header starting with 0. 919 ;; FIXME refactoring: Should have an attribute `buffer' for the buffer this
924 (level nil)) 920 ;; title is found in. This breaks lots and lots of tests.
921 ;; However, with private constructor they may not be
922 ;; necessary any more. In case it is really a buffer then
923 ;; also `match' could be real data from `match-data' which
924 ;; contains markers instead of integers.
925 )
925 926
926;; Private class methods 927;; Private class methods
927 928
928(defun rst-Ttl--validate-ado (ado) 929(defun rst-Ttl--validate-ado (ado)
929 ;; testcover: ok. 930 ;; testcover: ok.
930 "Return valid ADO or signal error." 931 "Return valid ADO or signal error."
931 (unless (or (null ado) (rst-Ado-p ado)) 932 (cl-check-type ado (or null rst-Ado))
932 (signal 'wrong-type-argument
933 (list 'null 'rst-Ado-p ado)))
934 ado) 933 ado)
935 934
936(defun rst-Ttl--validate-match (match ado) 935(defun rst-Ttl--validate-match (match ado)
937 ;; testcover: ok. 936 ;; testcover: ok.
938 "Return valid MATCH matching ADO or signal error." 937 "Return valid MATCH matching ADO or signal error."
939 (unless (listp match) 938 (cl-check-type ado (or null rst-Ado))
940 (signal 'wrong-type-argument 939 (cl-check-type match list)
941 (list 'listp match))) 940 (cl-check-type match (satisfies (lambda (m)
942 (unless (equal (length match) 8) 941 (equal (length m) 8)))
943 (signal 'args-out-of-range 942 "Match data must consist of exactly 8 buffer positions.")
944 '("Match data must consist of exactly 8 buffer positions."))) 943 (dolist (pos match)
945 (mapcar (lambda (pos) 944 (cl-check-type pos (or null integer-or-marker)))
946 (unless (or (null pos) (integer-or-marker-p pos)) 945 (cl-destructuring-bind (all-beg all-end
947 (signal 'wrong-type-argument 946 ovr-beg ovr-end
948 (list 'integer-or-marker-p 'null pos)))) 947 txt-beg txt-end
949 match) 948 und-beg und-end) match
950 (unless (and (integer-or-marker-p (nth 0 match)) 949 (unless (and (integer-or-marker-p all-beg) (integer-or-marker-p all-end))
951 (integer-or-marker-p (nth 1 match)))
952 (signal 'args-out-of-range
953 '("First two elements of match data must be buffer positions.")))
954 (cond
955 ((null ado)
956 (unless (and (null (nth 2 match))
957 (null (nth 3 match))
958 (integer-or-marker-p (nth 4 match))
959 (integer-or-marker-p (nth 5 match))
960 (null (nth 6 match))
961 (null (nth 7 match)))
962 (signal 'args-out-of-range
963 '("For a title candidate exactly the third match pair must be set."))))
964 ((rst-Ado-is-transition ado)
965 (unless (and (null (nth 2 match))
966 (null (nth 3 match))
967 (integer-or-marker-p (nth 4 match))
968 (integer-or-marker-p (nth 5 match))
969 (null (nth 6 match))
970 (null (nth 7 match)))
971 (signal 'args-out-of-range 950 (signal 'args-out-of-range
972 '("For a transition exactly the third match pair must be set.")))) 951 '("First two elements of match data must be buffer positions.")))
973 ((rst-Ado-is-simple ado) 952 (cond
974 (unless (and (null (nth 2 match)) 953 ((null ado)
975 (null (nth 3 match)) 954 (unless (and (null ovr-beg) (null ovr-end)
976 (integer-or-marker-p (nth 4 match)) 955 (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end)
977 (integer-or-marker-p (nth 5 match)) 956 (null und-beg) (null und-end))
978 (integer-or-marker-p (nth 6 match)) 957 (signal 'args-out-of-range
979 (integer-or-marker-p (nth 7 match))) 958 '("For a title candidate exactly the third match pair must be set."))))
980 (signal 'args-out-of-range 959 ((rst-Ado-is-transition ado)
981 '("For a simple section adornment exactly the third and fourth match pair must be set.")))) 960 (unless (and (null ovr-beg) (null ovr-end)
982 (t ;; over-and-under 961 (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end)
983 (unless (and (integer-or-marker-p (nth 2 match)) 962 (null und-beg) (null und-end))
984 (integer-or-marker-p (nth 3 match)) 963 (signal 'args-out-of-range
985 (integer-or-marker-p (nth 4 match)) 964 '("For a transition exactly the third match pair must be set."))))
986 (integer-or-marker-p (nth 5 match)) 965 ((rst-Ado-is-simple ado)
987 (or (null (nth 6 match)) (integer-or-marker-p (nth 6 match))) 966 (unless (and (null ovr-beg) (null ovr-end)
988 (or (null (nth 7 match)) (integer-or-marker-p (nth 7 match)))) 967 (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end)
989 (signal 'args-out-of-range 968 (integer-or-marker-p und-beg) (integer-or-marker-p und-end))
990 '("For a over-and-under section adornment all match pairs must be set."))))) 969 (signal 'args-out-of-range
970 '("For a simple section adornment exactly the third and fourth match pair must be set."))))
971 (t ; over-and-under
972 (unless (and (integer-or-marker-p ovr-beg) (integer-or-marker-p ovr-end)
973 (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end)
974 (or (null und-beg) (integer-or-marker-p und-beg))
975 (or (null und-end) (integer-or-marker-p und-end)))
976 (signal 'args-out-of-range
977 '("For a over-and-under section adornment all match pairs must be set."))))))
991 match) 978 match)
992 979
993(defun rst-Ttl--validate-indent (indent ado) 980(defun rst-Ttl--validate-indent (indent ado)
994 ;; testcover: ok. 981 ;; testcover: ok.
995 "Return valid INDENT for ADO or signal error." 982 "Return valid INDENT for ADO or signal error."
996 (if (and ado (rst-Ado-is-transition ado)) 983 (if (and ado (rst-Ado-is-transition ado))
997 (unless (null indent) 984 (cl-check-type indent null
998 (signal 'args-out-of-range 985 "Indent for a transition must be nil.")
999 '("Indent for a transition must be nil."))) 986 (cl-check-type indent (integer 0 *)
1000 (unless (integerp indent) 987 "Indent for a section header must be non-negative."))
1001 (signal 'wrong-type-argument
1002 (list 'integerp indent)))
1003 (unless (>= indent 0)
1004 (signal 'args-out-of-range
1005 '("Indent for a section header must be non-negative."))))
1006 indent) 988 indent)
1007 989
1008(defun rst-Ttl--validate-hdr (hdr ado indent)
1009 ;; testcover: ok.
1010 "Return valid HDR in relation to ADO and INDENT or signal error."
1011 (unless (rst-Hdr-p hdr)
1012 (signal 'wrong-type-argument
1013 (list 'rst-Hdr-p hdr)))
1014 (unless (rst-Ado-equal (rst-Hdr-ado hdr) ado)
1015 (signal 'args-out-of-range
1016 '("Basic adornment and adornment in header must match.")))
1017 (unless (equal (rst-Hdr-indent hdr) indent)
1018 (signal 'args-out-of-range
1019 '("Basic indent and indent in header must match.")))
1020 hdr)
1021
1022(defun rst-Ttl--validate-text (text ado) 990(defun rst-Ttl--validate-text (text ado)
1023 ;; testcover: ok. 991 ;; testcover: ok.
1024 "Return valid TEXT for ADO or signal error." 992 "Return valid TEXT for ADO or signal error."
1025 (if (and ado (rst-Ado-is-transition ado)) 993 (if (and ado (rst-Ado-is-transition ado))
1026 (unless (null text) 994 (cl-check-type text null
1027 (signal 'args-out-of-range 995 "Transitions may not have title text.")
1028 '("Transitions may not have title text."))) 996 (cl-check-type text string))
1029 (unless (stringp text)
1030 (signal 'wrong-type-argument
1031 (list 'stringp text))))
1032 text) 997 text)
1033 998
1034(defun rst-Ttl--validate-level (level) 999;; Public class methods
1000
1001(defun rst-Ttl-from-buffer (ado beg-ovr beg-txt beg-und txt)
1035 ;; testcover: ok. 1002 ;; testcover: ok.
1036 "Return valid LEVEL or signal error." 1003 "Return a `rst-Ttl' constructed from information in the current buffer.
1037 (unless (integerp level) 1004ADO is the adornment or nil for a title candidate. BEG-OVR and
1038 (signal 'wrong-type-argument 1005BEG-UND are the starting points of the overline or underline,
1039 (list 'integerp level))) 1006respectively. They may be nil if the respective thing is missing.
1040 (unless (>= level 0) 1007BEG-TXT is the beginning of the title line or the transition and
1041 (signal 'args-out-of-range 1008must be given. The end of the line is used as the end point. TXT
1042 '("Level must be non-negative."))) 1009is the title text or nil. If TXT is given the indentation of the
1043 level) 1010line containing BEG-TXT is used as indentation. Match group 0 is
1011derived from the remaining information."
1012 (cl-check-type beg-txt integer-or-marker)
1013 (save-excursion
1014 (let ((end-ovr (when beg-ovr
1015 (goto-char beg-ovr)
1016 (line-end-position)))
1017 (end-txt (progn
1018 (goto-char beg-txt)
1019 (line-end-position)))
1020 (end-und (when beg-und
1021 (goto-char beg-und)
1022 (line-end-position)))
1023 (ind (when txt
1024 (goto-char beg-txt)
1025 (current-indentation))))
1026 (rst-Ttl--new ado
1027 (list
1028 (or beg-ovr beg-txt) (or end-und end-txt)
1029 beg-ovr end-ovr
1030 beg-txt end-txt
1031 beg-und end-und)
1032 ind txt))))
1044 1033
1045;; Public methods 1034;; Public methods
1046 1035
1047(defun rst-Ttl-evaluate-hdr (self)
1048 ;; testcover: ok.
1049 "Check for `ado' and `indent' in SELF forming a valid `rst-Hdr'.
1050Set and return it or nil if no valid `rst-Hdr' can be formed."
1051 (setf (rst-Ttl-hdr self)
1052 (condition-case nil
1053 (rst-Hdr-new (rst-Ttl-ado self) (rst-Ttl-indent self))
1054 (error nil))))
1055
1056(defun rst-Ttl-set-level (self level)
1057 ;; testcover: ok.
1058 "In SELF set and return LEVEL or nil if invalid."
1059 (setf (rst-Ttl-level self)
1060 (rst-Ttl--validate-level level)))
1061
1062(defun rst-Ttl-get-title-beginning (self) 1036(defun rst-Ttl-get-title-beginning (self)
1063 ;; testcover: ok. 1037 ;; testcover: ok.
1064 "Return position of beginning of title text of SELF. 1038 "Return position of beginning of title text of SELF.
1065This position should always be at the start of a line." 1039This position should always be at the start of a line."
1040 (cl-check-type self rst-Ttl)
1066 (nth 4 (rst-Ttl-match self))) 1041 (nth 4 (rst-Ttl-match self)))
1067 1042
1068(defun rst-Ttl-get-beginning (self) 1043(defun rst-Ttl-get-beginning (self)
1069 ;; testcover: ok. 1044 ;; testcover: ok.
1070 "Return position of beginning of whole SELF." 1045 "Return position of beginning of whole SELF."
1046 (cl-check-type self rst-Ttl)
1071 (nth 0 (rst-Ttl-match self))) 1047 (nth 0 (rst-Ttl-match self)))
1072 1048
1073(defun rst-Ttl-get-end (self) 1049(defun rst-Ttl-get-end (self)
1074 ;; testcover: ok. 1050 ;; testcover: ok.
1075 "Return position of end of whole SELF." 1051 "Return position of end of whole SELF."
1052 (cl-check-type self rst-Ttl)
1076 (nth 1 (rst-Ttl-match self))) 1053 (nth 1 (rst-Ttl-match self)))
1077 1054
1055(defun rst-Ttl-is-section (self)
1056 ;; testcover: ok.
1057 "Return non-nil if SELF is a section header or candidate."
1058 (cl-check-type self rst-Ttl)
1059 (rst-Ttl-text self))
1060
1061(defun rst-Ttl-is-candidate (self)
1062 ;; testcover: ok.
1063 "Return non-nil if SELF is a candidate for a section header."
1064 (cl-check-type self rst-Ttl)
1065 (not (rst-Ttl-ado self)))
1066
1067(defun rst-Ttl-contains (self position)
1068 "Return whether SELF contain POSITION.
1069Return 0 if SELF contains POSITION, < 0 if SELF ends before
1070POSITION and > 0 if SELF starts after position."
1071 (cl-check-type self rst-Ttl)
1072 (cl-check-type position integer-or-marker)
1073 (cond
1074 ((< (nth 1 (rst-Ttl-match self)) position)
1075 -1)
1076 ((> (nth 0 (rst-Ttl-match self)) position)
1077 +1)
1078 (0)))
1079
1078 1080
1079;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1081;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1080;; Class rst-Stn 1082;; Class rst-Stn
1081 1083
1082(defstruct 1084(cl-defstruct
1083 (rst-Stn 1085 (rst-Stn
1084 (:constructor nil) ;; Prevent creating unchecked values. 1086 (:constructor nil) ; Prevent creating unchecked values.
1085 ;; Construct while all parameters must be valid. 1087 ;; Construct while all parameters must be valid.
1086 (:constructor 1088 (:constructor
1087 rst-Stn-new 1089 rst-Stn-new
@@ -1102,45 +1104,33 @@ This type is immutable."
1102 (level nil :read-only t) 1104 (level nil :read-only t)
1103 ;; The list of children of the node. 1105 ;; The list of children of the node.
1104 (children nil :read-only t)) 1106 (children nil :read-only t))
1107;; FIXME refactoring: Should have an attribute `buffer' for the buffer this
1108;; title is found in. Or use `rst-Ttl-buffer'.
1105 1109
1106;; Private class methods 1110;; Private class methods
1107 1111
1108(defun rst-Stn--validate-ttl (ttl) 1112(defun rst-Stn--validate-ttl (ttl)
1109 ;; testcover: ok. 1113 ;; testcover: ok.
1110 "Return valid TTL or signal error." 1114 "Return valid TTL or signal error."
1111 (unless (or (null ttl) (rst-Ttl-p ttl)) 1115 (cl-check-type ttl (or null rst-Ttl))
1112 (signal 'wrong-type-argument
1113 (list 'null 'rst-Ttl-p ttl)))
1114 ttl) 1116 ttl)
1115 1117
1116(defun rst-Stn--validate-level (level ttl) 1118(defun rst-Stn--validate-level (level ttl)
1117 ;; testcover: ok. 1119 ;; testcover: ok.
1118 "Return valid LEVEL for TTL or signal error." 1120 "Return valid LEVEL for TTL or signal error."
1119 (unless (integerp level) 1121 (cl-check-type level integer)
1120 (signal 'wrong-type-argument 1122 (when (and ttl (< level 0))
1121 (list 'integerp level))) 1123 ;; testcover: Never reached because a title may not have a negative level
1122 (when ttl 1124 (signal 'args-out-of-range
1123 (unless (or (not (rst-Ttl-level ttl)) 1125 '("Top level node must not have a title.")))
1124 (equal (rst-Ttl-level ttl) level))
1125 (signal 'args-out-of-range
1126 '("A title must have correct level or none at all.")))
1127 (when (< level 0)
1128 ;; testcover: Never reached because a title may not have a negative level
1129 (signal 'args-out-of-range
1130 '("Top level node must not have a title."))))
1131 level) 1126 level)
1132 1127
1133(defun rst-Stn--validate-children (children ttl) 1128(defun rst-Stn--validate-children (children ttl)
1134 ;; testcover: ok. 1129 ;; testcover: ok.
1135 "Return valid CHILDREN for TTL or signal error." 1130 "Return valid CHILDREN for TTL or signal error."
1136 (unless (listp children) 1131 (cl-check-type children list)
1137 (signal 'wrong-type-argument 1132 (dolist (child children)
1138 (list 'listp children))) 1133 (cl-check-type child rst-Stn))
1139 (mapcar (lambda (child)
1140 (unless (rst-Stn-p child)
1141 (signal 'wrong-type-argument
1142 (list 'rst-Stn-p child))))
1143 children)
1144 (unless (or ttl children) 1134 (unless (or ttl children)
1145 (signal 'args-out-of-range 1135 (signal 'args-out-of-range
1146 '("A missing node must have children."))) 1136 '("A missing node must have children.")))
@@ -1152,9 +1142,7 @@ This type is immutable."
1152 ;; testcover: ok. 1142 ;; testcover: ok.
1153 "Return the beginning of the title of SELF. 1143 "Return the beginning of the title of SELF.
1154Handles missing node properly." 1144Handles missing node properly."
1155 (unless (rst-Stn-p self) 1145 (cl-check-type self rst-Stn)
1156 (signal 'wrong-type-argument
1157 (list 'rst-Stn-p self)))
1158 (let ((ttl (rst-Stn-ttl self))) 1146 (let ((ttl (rst-Stn-ttl self)))
1159 (if ttl 1147 (if ttl
1160 (rst-Ttl-get-title-beginning ttl) 1148 (rst-Ttl-get-title-beginning ttl)
@@ -1164,9 +1152,7 @@ Handles missing node properly."
1164 ;; testcover: ok. 1152 ;; testcover: ok.
1165 "Return title text of SELF or DEFAULT if SELF is a missing node. 1153 "Return title text of SELF or DEFAULT if SELF is a missing node.
1166For a missing node and no DEFAULT given return a standard title text." 1154For a missing node and no DEFAULT given return a standard title text."
1167 (unless (rst-Stn-p self) 1155 (cl-check-type self rst-Stn)
1168 (signal 'wrong-type-argument
1169 (list 'rst-Stn-p self)))
1170 (let ((ttl (rst-Stn-ttl self))) 1156 (let ((ttl (rst-Stn-ttl self)))
1171 (cond 1157 (cond
1172 (ttl 1158 (ttl
@@ -1177,9 +1163,7 @@ For a missing node and no DEFAULT given return a standard title text."
1177(defun rst-Stn-is-top (self) 1163(defun rst-Stn-is-top (self)
1178 ;; testcover: ok. 1164 ;; testcover: ok.
1179 "Return non-nil if SELF is a top level node." 1165 "Return non-nil if SELF is a top level node."
1180 (unless (rst-Stn-p self) 1166 (cl-check-type self rst-Stn)
1181 (signal 'wrong-type-argument
1182 (list 'rst-Stn-p self)))
1183 (< (rst-Stn-level self) 0)) 1167 (< (rst-Stn-level self) 0))
1184 1168
1185 1169
@@ -1203,13 +1187,13 @@ as well but give an additional message."
1203 (forwarder-function (intern forwarder-function-name))) 1187 (forwarder-function (intern forwarder-function-name)))
1204 (unless (fboundp forwarder-function) 1188 (unless (fboundp forwarder-function)
1205 (defalias forwarder-function 1189 (defalias forwarder-function
1206 (lexical-let ((key key) (def def)) 1190 (lambda ()
1207 (lambda () 1191 (interactive)
1208 (interactive) 1192 (call-interactively def)
1209 (call-interactively def) 1193 (message "[Deprecated use of key %s; use key %s instead]"
1210 (message "[Deprecated use of key %s; use key %s instead]" 1194 (key-description (this-command-keys))
1211 (key-description (this-command-keys)) 1195 (key-description key)))
1212 (key-description key)))) 1196 ;; FIXME: In Emacs-25 we could use (:documentation ...) instead.
1213 (format "Deprecated binding for %s, use \\[%s] instead." 1197 (format "Deprecated binding for %s, use \\[%s] instead."
1214 def def))) 1198 def def)))
1215 (dolist (dep-key deprecated) 1199 (dolist (dep-key deprecated)
@@ -1220,40 +1204,40 @@ as well but give an additional message."
1220 (let ((map (make-sparse-keymap))) 1204 (let ((map (make-sparse-keymap)))
1221 1205
1222 ;; \C-c is the general keymap. 1206 ;; \C-c is the general keymap.
1223 (rst-define-key map [?\C-c ?\C-h] 'describe-prefix-bindings) 1207 (rst-define-key map [?\C-c ?\C-h] #'describe-prefix-bindings)
1224 1208
1225 ;; 1209 ;;
1226 ;; Section Adornments 1210 ;; Section Adornments
1227 ;; 1211 ;;
1228 ;; The adjustment function that adorns or rotates a section title. 1212 ;; The adjustment function that adorns or rotates a section title.
1229 (rst-define-key map [?\C-c ?\C-=] 'rst-adjust [?\C-c ?\C-a t]) 1213 (rst-define-key map [?\C-c ?\C-=] #'rst-adjust [?\C-c ?\C-a t])
1230 (rst-define-key map [?\C-=] 'rst-adjust) ; Does not work on macOS and 1214 (rst-define-key map [?\C-=] #'rst-adjust) ; Does not work on macOS and
1231 ; on consoles. 1215 ; on consoles.
1232 1216
1233 ;; \C-c \C-a is the keymap for adornments. 1217 ;; \C-c \C-a is the keymap for adornments.
1234 (rst-define-key map [?\C-c ?\C-a ?\C-h] 'describe-prefix-bindings) 1218 (rst-define-key map [?\C-c ?\C-a ?\C-h] #'describe-prefix-bindings)
1235 ;; Another binding which works with all types of input. 1219 ;; Another binding which works with all types of input.
1236 (rst-define-key map [?\C-c ?\C-a ?\C-a] 'rst-adjust) 1220 (rst-define-key map [?\C-c ?\C-a ?\C-a] #'rst-adjust)
1237 ;; Display the hierarchy of adornments implied by the current document 1221 ;; Display the hierarchy of adornments implied by the current document
1238 ;; contents. 1222 ;; contents.
1239 (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-hdr-hierarchy) 1223 (rst-define-key map [?\C-c ?\C-a ?\C-d] #'rst-display-hdr-hierarchy)
1240 ;; Homogenize the adornments in the document. 1224 ;; Homogenize the adornments in the document.
1241 (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-sections 1225 (rst-define-key map [?\C-c ?\C-a ?\C-s] #'rst-straighten-sections
1242 [?\C-c ?\C-s]) 1226 [?\C-c ?\C-s])
1243 1227
1244 ;; 1228 ;;
1245 ;; Section Movement and Selection 1229 ;; Section Movement and Selection
1246 ;; 1230 ;;
1247 ;; Mark the subsection where the cursor is. 1231 ;; Mark the subsection where the cursor is.
1248 (rst-define-key map [?\C-\M-h] 'rst-mark-section 1232 (rst-define-key map [?\C-\M-h] #'rst-mark-section
1249 ;; Same as mark-defun sgml-mark-current-element. 1233 ;; Same as mark-defun sgml-mark-current-element.
1250 [?\C-c ?\C-m]) 1234 [?\C-c ?\C-m])
1251 ;; Move backward/forward between section titles. 1235 ;; Move backward/forward between section titles.
1252 ;; FIXME: Also bind similar to outline mode. 1236 ;; FIXME: Also bind similar to outline mode.
1253 (rst-define-key map [?\C-\M-a] 'rst-backward-section 1237 (rst-define-key map [?\C-\M-a] #'rst-backward-section
1254 ;; Same as beginning-of-defun. 1238 ;; Same as beginning-of-defun.
1255 [?\C-c ?\C-n]) 1239 [?\C-c ?\C-n])
1256 (rst-define-key map [?\C-\M-e] 'rst-forward-section 1240 (rst-define-key map [?\C-\M-e] #'rst-forward-section
1257 ;; Same as end-of-defun. 1241 ;; Same as end-of-defun.
1258 [?\C-c ?\C-p]) 1242 [?\C-c ?\C-p])
1259 1243
@@ -1261,69 +1245,69 @@ as well but give an additional message."
1261 ;; Operating on regions 1245 ;; Operating on regions
1262 ;; 1246 ;;
1263 ;; \C-c \C-r is the keymap for regions. 1247 ;; \C-c \C-r is the keymap for regions.
1264 (rst-define-key map [?\C-c ?\C-r ?\C-h] 'describe-prefix-bindings) 1248 (rst-define-key map [?\C-c ?\C-r ?\C-h] #'describe-prefix-bindings)
1265 ;; Makes region a line-block. 1249 ;; Makes region a line-block.
1266 (rst-define-key map [?\C-c ?\C-r ?\C-l] 'rst-line-block-region 1250 (rst-define-key map [?\C-c ?\C-r ?\C-l] #'rst-line-block-region
1267 [?\C-c ?\C-d]) 1251 [?\C-c ?\C-d])
1268 ;; Shift region left or right according to tabs. 1252 ;; Shift region left or right according to tabs.
1269 (rst-define-key map [?\C-c ?\C-r tab] 'rst-shift-region 1253 (rst-define-key map [?\C-c ?\C-r tab] #'rst-shift-region
1270 [?\C-c ?\C-r t] [?\C-c ?\C-l t]) 1254 [?\C-c ?\C-r t] [?\C-c ?\C-l t])
1271 1255
1272 ;; 1256 ;;
1273 ;; Operating on lists 1257 ;; Operating on lists
1274 ;; 1258 ;;
1275 ;; \C-c \C-l is the keymap for lists. 1259 ;; \C-c \C-l is the keymap for lists.
1276 (rst-define-key map [?\C-c ?\C-l ?\C-h] 'describe-prefix-bindings) 1260 (rst-define-key map [?\C-c ?\C-l ?\C-h] #'describe-prefix-bindings)
1277 ;; Makes paragraphs in region as a bullet list. 1261 ;; Makes paragraphs in region as a bullet list.
1278 (rst-define-key map [?\C-c ?\C-l ?\C-b] 'rst-bullet-list-region 1262 (rst-define-key map [?\C-c ?\C-l ?\C-b] #'rst-bullet-list-region
1279 [?\C-c ?\C-b]) 1263 [?\C-c ?\C-b])
1280 ;; Makes paragraphs in region as a enumeration. 1264 ;; Makes paragraphs in region as a enumeration.
1281 (rst-define-key map [?\C-c ?\C-l ?\C-e] 'rst-enumerate-region 1265 (rst-define-key map [?\C-c ?\C-l ?\C-e] #'rst-enumerate-region
1282 [?\C-c ?\C-e]) 1266 [?\C-c ?\C-e])
1283 ;; Converts bullets to an enumeration. 1267 ;; Converts bullets to an enumeration.
1284 (rst-define-key map [?\C-c ?\C-l ?\C-c] 'rst-convert-bullets-to-enumeration 1268 (rst-define-key map [?\C-c ?\C-l ?\C-c] #'rst-convert-bullets-to-enumeration
1285 [?\C-c ?\C-v]) 1269 [?\C-c ?\C-v])
1286 ;; Make sure that all the bullets in the region are consistent. 1270 ;; Make sure that all the bullets in the region are consistent.
1287 (rst-define-key map [?\C-c ?\C-l ?\C-s] 'rst-straighten-bullets-region 1271 (rst-define-key map [?\C-c ?\C-l ?\C-s] #'rst-straighten-bullets-region
1288 [?\C-c ?\C-w]) 1272 [?\C-c ?\C-w])
1289 ;; Insert a list item. 1273 ;; Insert a list item.
1290 (rst-define-key map [?\C-c ?\C-l ?\C-i] 'rst-insert-list) 1274 (rst-define-key map [?\C-c ?\C-l ?\C-i] #'rst-insert-list)
1291 1275
1292 ;; 1276 ;;
1293 ;; Table-of-Contents Features 1277 ;; Table-of-Contents Features
1294 ;; 1278 ;;
1295 ;; \C-c \C-t is the keymap for table of contents. 1279 ;; \C-c \C-t is the keymap for table of contents.
1296 (rst-define-key map [?\C-c ?\C-t ?\C-h] 'describe-prefix-bindings) 1280 (rst-define-key map [?\C-c ?\C-t ?\C-h] #'describe-prefix-bindings)
1297 ;; Enter a TOC buffer to view and move to a specific section. 1281 ;; Enter a TOC buffer to view and move to a specific section.
1298 (rst-define-key map [?\C-c ?\C-t ?\C-t] 'rst-toc) 1282 (rst-define-key map [?\C-c ?\C-t ?\C-t] #'rst-toc)
1299 ;; Insert a TOC here. 1283 ;; Insert a TOC here.
1300 (rst-define-key map [?\C-c ?\C-t ?\C-i] 'rst-toc-insert 1284 (rst-define-key map [?\C-c ?\C-t ?\C-i] #'rst-toc-insert
1301 [?\C-c ?\C-i]) 1285 [?\C-c ?\C-i])
1302 ;; Update the document's TOC (without changing the cursor position). 1286 ;; Update the document's TOC (without changing the cursor position).
1303 (rst-define-key map [?\C-c ?\C-t ?\C-u] 'rst-toc-update 1287 (rst-define-key map [?\C-c ?\C-t ?\C-u] #'rst-toc-update
1304 [?\C-c ?\C-u]) 1288 [?\C-c ?\C-u])
1305 ;; Go to the section under the cursor (cursor must be in TOC). 1289 ;; Go to the section under the cursor (cursor must be in internal TOC).
1306 (rst-define-key map [?\C-c ?\C-t ?\C-j] 'rst-goto-section 1290 (rst-define-key map [?\C-c ?\C-t ?\C-j] #'rst-toc-follow-link
1307 [?\C-c ?\C-f]) 1291 [?\C-c ?\C-f])
1308 1292
1309 ;; 1293 ;;
1310 ;; Converting Documents from Emacs 1294 ;; Converting Documents from Emacs
1311 ;; 1295 ;;
1312 ;; \C-c \C-c is the keymap for compilation. 1296 ;; \C-c \C-c is the keymap for compilation.
1313 (rst-define-key map [?\C-c ?\C-c ?\C-h] 'describe-prefix-bindings) 1297 (rst-define-key map [?\C-c ?\C-c ?\C-h] #'describe-prefix-bindings)
1314 ;; Run one of two pre-configured toolset commands on the document. 1298 ;; Run one of two pre-configured toolset commands on the document.
1315 (rst-define-key map [?\C-c ?\C-c ?\C-c] 'rst-compile 1299 (rst-define-key map [?\C-c ?\C-c ?\C-c] #'rst-compile
1316 [?\C-c ?1]) 1300 [?\C-c ?1])
1317 (rst-define-key map [?\C-c ?\C-c ?\C-a] 'rst-compile-alt-toolset 1301 (rst-define-key map [?\C-c ?\C-c ?\C-a] #'rst-compile-alt-toolset
1318 [?\C-c ?2]) 1302 [?\C-c ?2])
1319 ;; Convert the active region to pseudo-xml using the docutils tools. 1303 ;; Convert the active region to pseudo-xml using the docutils tools.
1320 (rst-define-key map [?\C-c ?\C-c ?\C-x] 'rst-compile-pseudo-region 1304 (rst-define-key map [?\C-c ?\C-c ?\C-x] #'rst-compile-pseudo-region
1321 [?\C-c ?3]) 1305 [?\C-c ?3])
1322 ;; Convert the current document to PDF and launch a viewer on the results. 1306 ;; Convert the current document to PDF and launch a viewer on the results.
1323 (rst-define-key map [?\C-c ?\C-c ?\C-p] 'rst-compile-pdf-preview 1307 (rst-define-key map [?\C-c ?\C-c ?\C-p] #'rst-compile-pdf-preview
1324 [?\C-c ?4]) 1308 [?\C-c ?4])
1325 ;; Convert the current document to S5 slides and view in a web browser. 1309 ;; Convert the current document to S5 slides and view in a web browser.
1326 (rst-define-key map [?\C-c ?\C-c ?\C-s] 'rst-compile-slides-preview 1310 (rst-define-key map [?\C-c ?\C-c ?\C-s] #'rst-compile-slides-preview
1327 [?\C-c ?5]) 1311 [?\C-c ?5])
1328 1312
1329 map) 1313 map)
@@ -1333,7 +1317,8 @@ This inherits from Text mode.")
1333 1317
1334;; Abbrevs. 1318;; Abbrevs.
1335(define-abbrev-table 'rst-mode-abbrev-table 1319(define-abbrev-table 'rst-mode-abbrev-table
1336 (mapcar (lambda (x) (append x '(nil 0 system))) 1320 (mapcar #'(lambda (x)
1321 (append x '(nil 0 system)))
1337 '(("contents" ".. contents::\n..\n ") 1322 '(("contents" ".. contents::\n..\n ")
1338 ("con" ".. contents::\n..\n ") 1323 ("con" ".. contents::\n..\n ")
1339 ("cont" "[...]") 1324 ("cont" "[...]")
@@ -1381,6 +1366,7 @@ The hook for `text-mode' is run before this one."
1381(require 'newcomment) 1366(require 'newcomment)
1382 1367
1383(defvar electric-pair-pairs) 1368(defvar electric-pair-pairs)
1369(defvar electric-indent-inhibit)
1384 1370
1385;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files 1371;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files
1386;; use *.txt, but this is too generic to be set as a default. 1372;; use *.txt, but this is too generic to be set as a default.
@@ -1411,10 +1397,10 @@ highlighting.
1411 (:seq hws-tag par-tag- bli-sfx)))) 1397 (:seq hws-tag par-tag- bli-sfx))))
1412 1398
1413 ;; Indenting and filling. 1399 ;; Indenting and filling.
1414 (setq-local indent-line-function 'rst-indent-line) 1400 (setq-local indent-line-function #'rst-indent-line)
1415 (setq-local adaptive-fill-mode t) 1401 (setq-local adaptive-fill-mode t)
1416 (setq-local adaptive-fill-regexp (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) 1402 (setq-local adaptive-fill-regexp (rst-re 'hws-tag 'par-tag- "?" 'hws-tag))
1417 (setq-local adaptive-fill-function 'rst-adaptive-fill) 1403 (setq-local adaptive-fill-function #'rst-adaptive-fill)
1418 (setq-local fill-paragraph-handle-comment nil) 1404 (setq-local fill-paragraph-handle-comment nil)
1419 1405
1420 ;; Comments. 1406 ;; Comments.
@@ -1430,18 +1416,18 @@ highlighting.
1430 1416
1431 ;; Commenting in reStructuredText is very special so use our own set of 1417 ;; Commenting in reStructuredText is very special so use our own set of
1432 ;; functions. 1418 ;; functions.
1433 (setq-local comment-line-break-function 'rst-comment-line-break) 1419 (setq-local comment-line-break-function #'rst-comment-line-break)
1434 (setq-local comment-indent-function 'rst-comment-indent) 1420 (setq-local comment-indent-function #'rst-comment-indent)
1435 (setq-local comment-insert-comment-function 'rst-comment-insert-comment) 1421 (setq-local comment-insert-comment-function #'rst-comment-insert-comment)
1436 (setq-local comment-region-function 'rst-comment-region) 1422 (setq-local comment-region-function #'rst-comment-region)
1437 (setq-local uncomment-region-function 'rst-uncomment-region) 1423 (setq-local uncomment-region-function #'rst-uncomment-region)
1438 1424
1439 (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) 1425 (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`)))
1440 1426
1441 ;; Imenu and which function. 1427 ;; Imenu and which function.
1442 ;; FIXME: Check documentation of `which-function' for alternative ways to 1428 ;; FIXME: Check documentation of `which-function' for alternative ways to
1443 ;; determine the current function name. 1429 ;; determine the current function name.
1444 (setq-local imenu-create-index-function 'rst-imenu-create-index) 1430 (setq-local imenu-create-index-function #'rst-imenu-create-index)
1445 1431
1446 ;; Font lock. 1432 ;; Font lock.
1447 (setq-local font-lock-defaults 1433 (setq-local font-lock-defaults
@@ -1449,7 +1435,7 @@ highlighting.
1449 t nil nil nil 1435 t nil nil nil
1450 (font-lock-multiline . t) 1436 (font-lock-multiline . t)
1451 (font-lock-mark-block-function . mark-paragraph))) 1437 (font-lock-mark-block-function . mark-paragraph)))
1452 (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t) 1438 (add-hook 'font-lock-extend-region-functions #'rst-font-lock-extend-region t)
1453 1439
1454 ;; Text after a changed line may need new fontification. 1440 ;; Text after a changed line may need new fontification.
1455 (setq-local jit-lock-contextually t) 1441 (setq-local jit-lock-contextually t)
@@ -1562,9 +1548,9 @@ file."
1562 :type `(repeat 1548 :type `(repeat
1563 (group :tag "Adornment specification" 1549 (group :tag "Adornment specification"
1564 (choice :tag "Adornment character" 1550 (choice :tag "Adornment character"
1565 ,@(mapcar (lambda (char) 1551 ,@(mapcar #'(lambda (char)
1566 (list 'const 1552 (list 'const
1567 :tag (char-to-string char) char)) 1553 :tag (char-to-string char) char))
1568 rst-adornment-chars)) 1554 rst-adornment-chars))
1569 (radio :tag "Adornment type" 1555 (radio :tag "Adornment type"
1570 (const :tag "Overline and underline" over-and-under) 1556 (const :tag "Overline and underline" over-and-under)
@@ -1603,17 +1589,12 @@ search starts after this entry. Return nil if no new preferred
1603 ;; Start searching after the level of the previous adornment. 1589 ;; Start searching after the level of the previous adornment.
1604 (cdr (rst-Hdr-member-ado prev (rst-Hdr-preferred-adornments)))) 1590 (cdr (rst-Hdr-member-ado prev (rst-Hdr-preferred-adornments))))
1605 (rst-Hdr-preferred-adornments)))) 1591 (rst-Hdr-preferred-adornments))))
1606 (car 1592 (cl-find-if #'(lambda (cand)
1607 (rst-member-if (lambda (cand) 1593 (not (rst-Hdr-member-ado cand seen)))
1608 (not (rst-Hdr-member-ado cand seen))) 1594 candidates)))
1609 candidates))))
1610
1611(defun rst-delete-entire-line ()
1612 "Delete the entire current line without using the `kill-ring'."
1613 (delete-region (line-beginning-position)
1614 (line-beginning-position 2)))
1615 1595
1616(defun rst-update-section (hdr) 1596(defun rst-update-section (hdr)
1597 ;; testcover: ok.
1617 "Unconditionally update the style of the section header at point to HDR. 1598 "Unconditionally update the style of the section header at point to HDR.
1618If there are existing overline and/or underline from the 1599If there are existing overline and/or underline from the
1619existing adornment, they are removed before adding the 1600existing adornment, they are removed before adding the
@@ -1621,163 +1602,149 @@ requested adornment."
1621 (end-of-line) 1602 (end-of-line)
1622 (let ((indent (or (rst-Hdr-indent hdr) 0)) 1603 (let ((indent (or (rst-Hdr-indent hdr) 0))
1623 (marker (point-marker)) 1604 (marker (point-marker))
1624 len) 1605 new)
1625 1606
1626 ;; Fixup whitespace at the beginning and end of the line. 1607 ;; Fixup whitespace at the beginning and end of the line.
1627 (beginning-of-line) 1608 (1value
1609 (rst-forward-line-strict 0))
1628 (delete-horizontal-space) 1610 (delete-horizontal-space)
1629 (insert (make-string indent ? )) 1611 (insert (make-string indent ? ))
1630
1631 (end-of-line) 1612 (end-of-line)
1632 (delete-horizontal-space) 1613 (delete-horizontal-space)
1633 1614 (setq new (make-string (+ (current-column) indent) (rst-Hdr-get-char hdr)))
1634 ;; Set the current column, we're at the end of the title line.
1635 (setq len (+ (current-column) indent))
1636 1615
1637 ;; Remove previous line if it is an adornment. 1616 ;; Remove previous line if it is an adornment.
1638 (save-excursion 1617 ;; FIXME refactoring: Check whether this deletes `hdr' which *has* all the
1639 (forward-line -1) ;; FIXME testcover: Doesn't work when in first line of 1618 ;; data necessary.
1640 ;; buffer. 1619 (when (and (rst-forward-line-looking-at -1 'ado-beg-2-1)
1641 (if (and (looking-at (rst-re 'ado-beg-2-1))
1642 ;; Avoid removing the underline of a title right above us. 1620 ;; Avoid removing the underline of a title right above us.
1643 (save-excursion (forward-line -1) 1621 (not (rst-forward-line-looking-at -2 'ttl-beg-1)))
1644 (not (looking-at (rst-re 'ttl-beg-1))))) 1622 (rst-delete-entire-line -1))
1645 (rst-delete-entire-line)))
1646 1623
1647 ;; Remove following line if it is an adornment. 1624 ;; Remove following line if it is an adornment.
1648 (save-excursion 1625 (when (rst-forward-line-looking-at +1 'ado-beg-2-1)
1649 (forward-line +1) ;; FIXME testcover: Doesn't work when in last line 1626 (rst-delete-entire-line +1))
1650 ;; of buffer.
1651 (if (looking-at (rst-re 'ado-beg-2-1))
1652 (rst-delete-entire-line))
1653 ;; Add a newline if we're at the end of the buffer unless it is the final
1654 ;; empty line, for the subsequent inserting of the underline.
1655 (if (and (= (point) (buffer-end 1)) (not (bolp)))
1656 (newline 1)))
1657
1658 ;; Insert overline.
1659 (when (rst-Hdr-is-over-and-under hdr)
1660 (save-excursion
1661 (beginning-of-line)
1662 (open-line 1)
1663 (insert (make-string len (rst-Hdr-get-char hdr)))))
1664 1627
1665 ;; Insert underline. 1628 ;; Insert underline.
1666 (1value ;; Line has been inserted above. 1629 (unless (rst-forward-line-strict +1)
1667 (forward-line +1)) 1630 ;; Normalize buffer by adding final newline.
1631 (newline 1))
1668 (open-line 1) 1632 (open-line 1)
1669 (insert (make-string len (rst-Hdr-get-char hdr))) 1633 (insert new)
1634
1635 ;; Insert overline.
1636 (when (rst-Hdr-is-over-and-under hdr)
1637 (1value ; Underline inserted above.
1638 (rst-forward-line-strict -1))
1639 (open-line 1)
1640 (insert new))
1670 1641
1671 (1value ;; Line has been inserted above.
1672 (forward-line +1))
1673 (goto-char marker))) 1642 (goto-char marker)))
1674 1643
1675(defun rst-classify-adornment (adornment end) 1644(defun rst-classify-adornment (adornment end &optional accept-over-only)
1645 ;; testcover: ok.
1676 "Classify adornment string for section titles and transitions. 1646 "Classify adornment string for section titles and transitions.
1677ADORNMENT is the complete adornment string as found in the buffer 1647ADORNMENT is the complete adornment string as found in the buffer
1678with optional trailing whitespace. END is the point after the 1648with optional trailing whitespace. END is the point after the
1679last character of ADORNMENT. Return a `rst-Ttl' or nil if no 1649last character of ADORNMENT. Return a `rst-Ttl' or nil if no
1680syntactically valid adornment is found." 1650syntactically valid adornment is found. If ACCEPT-OVER-ONLY an
1651overline with a missing underline is accepted as valid and
1652returned."
1681 (save-excursion 1653 (save-excursion
1682 (save-match-data 1654 (save-match-data
1683 (when (string-match (rst-re 'ado-beg-2-1) adornment) 1655 (when (string-match (rst-re 'ado-beg-2-1) adornment)
1684 (goto-char end) 1656 (goto-char end)
1685 (let* ((ado-ch (string-to-char (match-string 2 adornment))) 1657 (let* ((ado-ch (string-to-char (match-string 2 adornment)))
1686 (ado-re (rst-re ado-ch 'adorep3-hlp)) 1658 (ado-re (rst-re ado-ch 'adorep3-hlp)) ; RE matching the
1687 (end-pnt (point)) 1659 ; adornment.
1688 (beg-pnt (progn 1660 (beg-pnt (progn
1689 (1value ;; No lines may be left to move. 1661 (1value
1690 (forward-line 0)) 1662 (rst-forward-line-strict 0))
1691 (point))) 1663 (point)))
1692 (nxt-emp ; Next line nonexistent or empty 1664 (nxt-emp ; Next line nonexistent or empty
1693 (save-excursion 1665 (not (rst-forward-line-looking-at +1 'lin-end #'not)))
1694 (or (not (zerop (forward-line 1)))
1695 ;; FIXME testcover: Add test classifying at the end of
1696 ;; buffer.
1697 (looking-at (rst-re 'lin-end)))))
1698 (prv-emp ; Previous line nonexistent or empty 1666 (prv-emp ; Previous line nonexistent or empty
1699 (save-excursion 1667 (not (rst-forward-line-looking-at -1 'lin-end #'not)))
1700 (or (not (zerop (forward-line -1)))
1701 (looking-at (rst-re 'lin-end)))))
1702 txt-blw 1668 txt-blw
1703 (ttl-blw ; Title found below starting here. 1669 (ttl-blw ; Title found below starting here.
1704 (save-excursion 1670 (rst-forward-line-looking-at
1705 (and 1671 +1 'ttl-beg-1
1706 (zerop (forward-line 1)) ;; FIXME testcover: Add test 1672 #'(lambda (mtcd)
1707 ;; classifying at the end of 1673 (when mtcd
1708 ;; buffer. 1674 (setq txt-blw (match-string-no-properties 1))
1709 (looking-at (rst-re 'ttl-beg-1)) 1675 (point)))))
1710 (setq txt-blw (match-string-no-properties 1))
1711 (point))))
1712 txt-abv 1676 txt-abv
1713 (ttl-abv ; Title found above starting here. 1677 (ttl-abv ; Title found above starting here.
1714 (save-excursion 1678 (rst-forward-line-looking-at
1715 (and 1679 -1 'ttl-beg-1
1716 (zerop (forward-line -1)) 1680 #'(lambda (mtcd)
1717 (looking-at (rst-re 'ttl-beg-1)) 1681 (when mtcd
1718 (setq txt-abv (match-string-no-properties 1)) 1682 (setq txt-abv (match-string-no-properties 1))
1719 (point)))) 1683 (point)))))
1720 (und-fnd ; Matching underline found starting here. 1684 (und-fnd ; Matching underline found starting here.
1721 (save-excursion 1685 (and ttl-blw
1722 (and ttl-blw 1686 (rst-forward-line-looking-at
1723 (zerop (forward-line 2)) ;; FIXME testcover: Add test 1687 +2 (list ado-re 'lin-end)
1724 ;; classifying at the end of 1688 #'(lambda (mtcd)
1725 ;; buffer. 1689 (when mtcd
1726 (looking-at (rst-re ado-re 'lin-end)) 1690 (point))))))
1727 (point))))
1728 (ovr-fnd ; Matching overline found starting here. 1691 (ovr-fnd ; Matching overline found starting here.
1729 (save-excursion 1692 (and ttl-abv
1730 (and ttl-abv 1693 (rst-forward-line-looking-at
1731 (zerop (forward-line -2)) 1694 -2 (list ado-re 'lin-end)
1732 (looking-at (rst-re ado-re 'lin-end)) 1695 #'(lambda (mtcd)
1733 (point)))) 1696 (when mtcd
1734 ado ind txt beg-ovr end-ovr beg-txt end-txt beg-und end-und) 1697 (point))))))
1698 (und-wng ; Wrong underline found starting here.
1699 (and ttl-blw
1700 (not und-fnd)
1701 (rst-forward-line-looking-at
1702 +2 'ado-beg-2-1
1703 #'(lambda (mtcd)
1704 (when mtcd
1705 (point))))))
1706 (ovr-wng ; Wrong overline found starting here.
1707 (and ttl-abv (not ovr-fnd)
1708 (rst-forward-line-looking-at
1709 -2 'ado-beg-2-1
1710 #'(lambda (mtcd)
1711 (when (and
1712 mtcd
1713 ;; An adornment above may be a legal
1714 ;; adornment for the line above - consider it
1715 ;; a wrong overline only when it is equally
1716 ;; long.
1717 (equal
1718 (length (match-string-no-properties 1))
1719 (length adornment)))
1720 (point)))))))
1735 (cond 1721 (cond
1736 ((and nxt-emp prv-emp) 1722 ((and nxt-emp prv-emp)
1737 ;; A transition. 1723 ;; A transition.
1738 (setq ado (rst-Ado-new-transition) 1724 (rst-Ttl-from-buffer (rst-Ado-new-transition)
1739 beg-txt beg-pnt 1725 nil beg-pnt nil nil))
1740 end-txt end-pnt)) 1726 (ovr-fnd ; Prefer overline match over underline match.
1741 ((or und-fnd ovr-fnd)
1742 ;; An overline with an underline. 1727 ;; An overline with an underline.
1743 (setq ado (rst-Ado-new-over-and-under ado-ch)) 1728 (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch)
1744 (let (;; Prefer overline match over underline match. 1729 ovr-fnd ttl-abv beg-pnt txt-abv))
1745 (und-pnt (if ovr-fnd beg-pnt und-fnd)) 1730 (und-fnd
1746 (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt)) 1731 ;; An overline with an underline.
1747 (txt-pnt (if ovr-fnd ttl-abv ttl-blw))) 1732 (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch)
1748 (goto-char ovr-pnt) 1733 beg-pnt ttl-blw und-fnd txt-blw))
1749 (setq beg-ovr (point) 1734 ((and ttl-abv (not ovr-wng))
1750 end-ovr (line-end-position))
1751 (goto-char txt-pnt)
1752 (setq beg-txt (point)
1753 end-txt (line-end-position)
1754 ind (current-indentation)
1755 txt (if ovr-fnd txt-abv txt-blw))
1756 (goto-char und-pnt)
1757 (setq beg-und (point)
1758 end-und (line-end-position))))
1759 (ttl-abv
1760 ;; An underline. 1735 ;; An underline.
1761 (setq ado (rst-Ado-new-simple ado-ch) 1736 (rst-Ttl-from-buffer (rst-Ado-new-simple ado-ch)
1762 beg-und beg-pnt 1737 nil ttl-abv beg-pnt txt-abv))
1763 end-und end-pnt) 1738 ((and accept-over-only ttl-blw (not und-wng))
1764 (goto-char ttl-abv) 1739 ;; An overline with a missing underline.
1765 (setq beg-txt (point) 1740 (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch)
1766 end-txt (line-end-position) 1741 beg-pnt ttl-blw nil txt-blw))
1767 ind (current-indentation)
1768 txt txt-abv))
1769 (t 1742 (t
1770 ;; Invalid adornment. 1743 ;; Invalid adornment.
1771 (setq ado nil))) 1744 nil)))))))
1772 (if ado
1773 (rst-Ttl-new ado
1774 (list
1775 (or beg-ovr beg-txt)
1776 (or end-und end-txt)
1777 beg-ovr end-ovr beg-txt end-txt beg-und end-und)
1778 ind txt)))))))
1779 1745
1780(defun rst-ttl-at-point () 1746(defun rst-ttl-at-point ()
1747 ;; testcover: ok.
1781 "Find a section title line around point and return its characteristics. 1748 "Find a section title line around point and return its characteristics.
1782If the point is on an adornment line find the respective title 1749If the point is on an adornment line find the respective title
1783line. If the point is on an empty line check previous or next 1750line. If the point is on an empty line check previous or next
@@ -1785,89 +1752,57 @@ line whether it is a suitable title line and use it if so. If
1785point is on a suitable title line use it. Return a `rst-Ttl' for 1752point is on a suitable title line use it. Return a `rst-Ttl' for
1786a section header or nil if no title line is found." 1753a section header or nil if no title line is found."
1787 (save-excursion 1754 (save-excursion
1788 (1value ;; No lines may be left to move. 1755 (save-match-data
1789 (forward-line 0)) 1756 (1value
1790 (let ((orig-pnt (point)) 1757 (rst-forward-line-strict 0))
1791 (orig-end (line-end-position))) 1758 (let* (cnd-beg ; Beginning of a title candidate.
1792 (cond 1759 cnd-txt ; Text of a title candidate.
1793 ((looking-at (rst-re 'ado-beg-2-1)) 1760 (cnd-fun #'(lambda (mtcd) ; Function setting title candidate data.
1794 ;; Adornment found - consider it. 1761 (when mtcd
1795 (let ((char (string-to-char (match-string-no-properties 2))) 1762 (setq cnd-beg (match-beginning 0))
1796 (r (rst-classify-adornment (match-string-no-properties 0) 1763 (setq cnd-txt (match-string-no-properties 1))
1797 (match-end 0)))) 1764 t)))
1798 (cond 1765 ttl)
1799 ((not r) 1766 (cond
1800 ;; Invalid adornment - check whether this is an overline with 1767 ((looking-at (rst-re 'ado-beg-2-1))
1801 ;; missing underline. 1768 ;; Adornment found - consider it.
1802 (if (and 1769 (setq ttl (rst-classify-adornment (match-string-no-properties 0)
1803 (zerop (forward-line 1)) 1770 (match-end 0) t)))
1804 (looking-at (rst-re 'ttl-beg-1))) 1771 ((looking-at (rst-re 'lin-end))
1805 (rst-Ttl-new (rst-Ado-new-over-and-under char) 1772 ;; Empty line found - check surrounding lines for a title.
1806 (list orig-pnt (line-end-position) 1773 (or
1807 orig-pnt orig-end 1774 (rst-forward-line-looking-at -1 'ttl-beg-1 cnd-fun)
1808 (point) (line-end-position) 1775 (rst-forward-line-looking-at +1 'ttl-beg-1 cnd-fun)))
1809 nil nil) 1776 ((looking-at (rst-re 'ttl-beg-1))
1810 (current-indentation) 1777 ;; Title line found - check for a following underline.
1811 (match-string-no-properties 1)))) 1778 (setq ttl (rst-forward-line-looking-at
1812 ((rst-Ado-is-transition (rst-Ttl-ado r)) 1779 1 'ado-beg-2-1
1813 nil) 1780 #'(lambda (mtcd)
1814 ;; Return any other classification as is. 1781 (when mtcd
1815 (r)))) 1782 (rst-classify-adornment
1816 ((looking-at (rst-re 'lin-end)) 1783 (match-string-no-properties 0) (match-end 0))))))
1817 ;; Empty line found - check surrounding lines for a title. 1784 ;; Title candidate found if no valid adornment found.
1818 (or 1785 (funcall cnd-fun (not ttl))))
1819 (save-excursion 1786 (cond
1820 (if (and (zerop (forward-line -1)) 1787 ((and ttl (rst-Ttl-is-section ttl))
1821 (looking-at (rst-re 'ttl-beg-1))) 1788 ttl)
1822 (rst-Ttl-new nil 1789 (cnd-beg
1823 (list (point) (line-end-position) 1790 (rst-Ttl-from-buffer nil nil cnd-beg nil cnd-txt)))))))
1824 nil nil
1825 (point) (line-end-position)
1826 nil nil)
1827 (current-indentation)
1828 (match-string-no-properties 1))))
1829 (save-excursion
1830 (if (and (zerop (forward-line 1))
1831 (looking-at (rst-re 'ttl-beg-1)))
1832 (rst-Ttl-new nil
1833 (list (point) (line-end-position)
1834 nil nil
1835 (point) (line-end-position)
1836 nil nil)
1837 (current-indentation)
1838 (match-string-no-properties 1))))))
1839 ((looking-at (rst-re 'ttl-beg-1))
1840 ;; Title line found - check for a following underline.
1841 (let ((txt (match-string-no-properties 1)))
1842 (or (rst-classify-adornment
1843 (buffer-substring-no-properties
1844 (line-beginning-position 2) (line-end-position 2))
1845 (line-end-position 2))
1846 ;; No valid adornment found.
1847 (rst-Ttl-new nil
1848 (list (point) (line-end-position)
1849 nil nil
1850 (point) (line-end-position)
1851 nil nil)
1852 (current-indentation)
1853 txt))))))))
1854 1791
1855;; The following function and variables are used to maintain information about 1792;; The following function and variables are used to maintain information about
1856;; current section adornment in a buffer local cache. Thus they can be used for 1793;; current section adornment in a buffer local cache. Thus they can be used for
1857;; font-locking and manipulation commands. 1794;; font-locking and manipulation commands.
1858 1795
1859(defvar rst-all-ttls-cache nil 1796(defvar-local rst-all-ttls-cache nil
1860 "All section adornments in the buffer as found by `rst-all-ttls'. 1797 "All section adornments in the buffer as found by `rst-all-ttls'.
1861Set to t when no section adornments were found.") 1798Set to t when no section adornments were found.")
1862(make-variable-buffer-local 'rst-all-ttls-cache)
1863 1799
1864;; FIXME: If this variable is set to a different value font-locking of section 1800;; FIXME: If this variable is set to a different value font-locking of section
1865;; headers is wrong. 1801;; headers is wrong.
1866(defvar rst-hdr-hierarchy-cache nil 1802(defvar-local rst-hdr-hierarchy-cache nil
1867 "Section hierarchy in the buffer as determined by `rst-hdr-hierarchy'. 1803 "Section hierarchy in the buffer as determined by `rst-hdr-hierarchy'.
1868Set to t when no section adornments were found. 1804Set to t when no section adornments were found.
1869Value depends on `rst-all-ttls-cache'.") 1805Value depends on `rst-all-ttls-cache'.")
1870(make-variable-buffer-local 'rst-hdr-hierarchy-cache)
1871 1806
1872(rst-testcover-add-1value 'rst-reset-section-caches) 1807(rst-testcover-add-1value 'rst-reset-section-caches)
1873(defun rst-reset-section-caches () 1808(defun rst-reset-section-caches ()
@@ -1876,94 +1811,91 @@ Should be called by interactive functions which deal with sections."
1876 (setq rst-all-ttls-cache nil 1811 (setq rst-all-ttls-cache nil
1877 rst-hdr-hierarchy-cache nil)) 1812 rst-hdr-hierarchy-cache nil))
1878 1813
1814(defun rst-all-ttls-compute ()
1815 ;; testcover: ok.
1816 "Return a list of `rst-Ttl' for current buffer with ascending line number."
1817 (save-excursion
1818 (save-match-data
1819 (let (ttls)
1820 (goto-char (point-min))
1821 ;; Iterate over all the section titles/adornments in the file.
1822 (while (re-search-forward (rst-re 'ado-beg-2-1) nil t)
1823 (let ((ttl (rst-classify-adornment
1824 (match-string-no-properties 0) (point))))
1825 (when (and ttl (rst-Ttl-is-section ttl))
1826 (when (rst-Ttl-hdr ttl)
1827 (push ttl ttls))
1828 (goto-char (rst-Ttl-get-end ttl)))))
1829 (nreverse ttls)))))
1830
1879(defun rst-all-ttls () 1831(defun rst-all-ttls ()
1880 "Return all the section adornments in the current buffer. 1832 "Return all the section adornments in the current buffer.
1881Return a list of `rst-Ttl' with ascending line number. 1833Return a list of `rst-Ttl' with ascending line number.
1882 1834
1883Uses and sets `rst-all-ttls-cache'." 1835Uses and sets `rst-all-ttls-cache'."
1884 (unless rst-all-ttls-cache 1836 (unless rst-all-ttls-cache
1885 (let (positions) 1837 (setq rst-all-ttls-cache (or (rst-all-ttls-compute) t)))
1886 ;; Iterate over all the section titles/adornments in the file.
1887 (save-excursion
1888 (save-match-data
1889 (goto-char (point-min))
1890 (while (re-search-forward (rst-re 'ado-beg-2-1) nil t)
1891 (let ((ttl (rst-classify-adornment
1892 (match-string-no-properties 0) (point))))
1893 (when (and ttl (rst-Ado-is-section (rst-Ttl-ado ttl)))
1894 (when (rst-Ttl-evaluate-hdr ttl)
1895 (push ttl positions))
1896 (goto-char (rst-Ttl-get-end ttl)))))
1897 (setq positions (nreverse positions))
1898 (setq rst-all-ttls-cache (or positions t))))))
1899 (if (eq rst-all-ttls-cache t) 1838 (if (eq rst-all-ttls-cache t)
1900 nil 1839 nil
1901 (mapcar 'rst-Ttl-copy rst-all-ttls-cache))) 1840 (copy-sequence rst-all-ttls-cache)))
1902 1841
1903(defun rst-infer-hdr-hierarchy (hdrs) 1842(defun rst-infer-hdr-hierarchy (hdrs)
1843 ;; testcover: ok.
1904 "Build a hierarchy from HDRS. 1844 "Build a hierarchy from HDRS.
1905HDRS reflects the order in which the headers appear in the 1845HDRS reflects the order in which the headers appear in the
1906buffer. Return a `rst-Hdr' list representing the hierarchy of 1846buffer. Return a `rst-Hdr' list representing the hierarchy of
1907headers in the buffer. Indentation is unified." 1847headers in the buffer. Indentation is unified."
1908 (let (ado2indents) 1848 (let (ado2indents) ; Associates `rst-Ado' with the set of indents seen for it.
1909 (dolist (hdr hdrs) 1849 (dolist (hdr hdrs)
1910 (let* ((ado (rst-Hdr-ado hdr)) 1850 (let* ((ado (rst-Hdr-ado hdr))
1911 (indent (rst-Hdr-indent hdr)) 1851 (indent (rst-Hdr-indent hdr))
1912 (found (assoc ado ado2indents))) 1852 (found (assoc ado ado2indents)))
1913 (if found 1853 (if found
1914 (unless (member indent (cdr found)) 1854 (setcdr found (cl-adjoin indent (cdr found)))
1915 ;; Append newly found indent.
1916 (setcdr found (append (cdr found) (list indent))))
1917 (push (list ado indent) ado2indents)))) 1855 (push (list ado indent) ado2indents))))
1918 (mapcar (lambda (ado_indents) 1856 (mapcar (cl-function
1919 (let ((ado (car ado_indents)) 1857 (lambda ((ado consistent &rest inconsistent))
1920 (indents (cdr ado_indents))) 1858 (rst-Hdr-new ado (if inconsistent
1921 (rst-Hdr-new 1859 rst-default-indent
1922 ado 1860 consistent))))
1923 (if (> (length indents) 1)
1924 ;; Indentations used inconsistently - use default.
1925 rst-default-indent
1926 ;; Only one indentation used - use this.
1927 (car indents)))))
1928 (nreverse ado2indents)))) 1861 (nreverse ado2indents))))
1929 1862
1930(defun rst-hdr-hierarchy (&optional ignore-current) 1863(defun rst-hdr-hierarchy (&optional ignore-position)
1864 ;; testcover: ok.
1931 "Return the hierarchy of section titles in the file as a `rst-Hdr' list. 1865 "Return the hierarchy of section titles in the file as a `rst-Hdr' list.
1932Each returned element may be used directly to create a section 1866Each returned element may be used directly to create a section
1933adornment on that level. If IGNORE-CURRENT a title found on the 1867adornment on that level. If IGNORE-POSITION a title containing
1934current line is not taken into account when building the 1868this position is not taken into account when building the
1935hierarchy unless it appears again elsewhere. This catches cases 1869hierarchy unless it appears again elsewhere. This catches cases
1936where the current title is edited and may not be final regarding 1870where the current title is edited and may not be final regarding
1937its level. 1871its level.
1938 1872
1939Uses and sets `rst-hdr-hierarchy-cache' unless IGNORE-CURRENT is 1873Uses and sets `rst-hdr-hierarchy-cache' unless IGNORE-POSITION is
1940given." 1874given."
1941 (let* ((all-ttls (rst-all-ttls)) 1875 (let* ((all-ttls (rst-all-ttls))
1942 (ignore-position (if ignore-current
1943 (line-beginning-position)))
1944 (ignore-ttl 1876 (ignore-ttl
1945 (if ignore-position 1877 (if ignore-position
1946 (car (member-if 1878 (cl-find-if
1947 (lambda (ttl) 1879 #'(lambda (ttl)
1948 (equal ignore-position (rst-Ttl-get-title-beginning ttl))) 1880 (equal (rst-Ttl-contains ttl ignore-position) 0))
1949 all-ttls)))) 1881 all-ttls)))
1950 (really-ignore 1882 (really-ignore
1951 (if ignore-ttl 1883 (if ignore-ttl
1952 (<= (count-if 1884 (<= (cl-count-if
1953 (lambda (ttl) 1885 #'(lambda (ttl)
1954 (rst-Ado-equal (rst-Ttl-ado ignore-ttl) (rst-Ttl-ado ttl))) 1886 (rst-Ado-equal (rst-Ttl-ado ignore-ttl)
1887 (rst-Ttl-ado ttl)))
1955 all-ttls) 1888 all-ttls)
1956 1))) 1889 1)))
1957 (real-ttls (delq (if really-ignore ignore-ttl) all-ttls))) 1890 (real-ttls (delq (if really-ignore ignore-ttl) all-ttls)))
1958 (mapcar ;; Protect cache. 1891 (copy-sequence ; Protect cache.
1959 'rst-Hdr-copy 1892 (if (and (not ignore-position) rst-hdr-hierarchy-cache)
1960 (if (and (not ignore-current) rst-hdr-hierarchy-cache)
1961 (if (eq rst-hdr-hierarchy-cache t) 1893 (if (eq rst-hdr-hierarchy-cache t)
1962 nil 1894 nil
1963 rst-hdr-hierarchy-cache) 1895 rst-hdr-hierarchy-cache)
1964 (let ((r (rst-infer-hdr-hierarchy (mapcar 'rst-Ttl-hdr real-ttls)))) 1896 (let ((r (rst-infer-hdr-hierarchy (mapcar #'rst-Ttl-hdr real-ttls))))
1965 (setq rst-hdr-hierarchy-cache 1897 (setq rst-hdr-hierarchy-cache
1966 (if ignore-current 1898 (if ignore-position
1967 ;; Clear cache reflecting that a possible update is not 1899 ;; Clear cache reflecting that a possible update is not
1968 ;; reflected. 1900 ;; reflected.
1969 nil 1901 nil
@@ -1971,48 +1903,43 @@ given."
1971 r))))) 1903 r)))))
1972 1904
1973(defun rst-all-ttls-with-level () 1905(defun rst-all-ttls-with-level ()
1906 ;; testcover: ok.
1974 "Return the section adornments with levels set according to hierarchy. 1907 "Return the section adornments with levels set according to hierarchy.
1975Return a list of `rst-Ttl' with ascending line number." 1908Return a list of (`rst-Ttl' . LEVEL) with ascending line number."
1976 (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) 1909 (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy))))
1977 (mapcar 1910 (mapcar
1978 (lambda (ttl) 1911 #'(lambda (ttl)
1979 (rst-Ttl-set-level ttl (rst-Ado-position (rst-Ttl-ado ttl) hier)) 1912 (cons ttl (rst-Ado-position (rst-Ttl-ado ttl) hier)))
1980 ttl) 1913 (rst-all-ttls))))
1981 (rst-all-ttls))))
1982 1914
1983(defun rst-get-previous-hdr () 1915(defun rst-get-previous-hdr ()
1984 "Return the `rst-Hdr' before point or nil if none." 1916 "Return the `rst-Hdr' before point or nil if none."
1985 (let ((ttls (rst-all-ttls)) 1917 (let ((prev (cl-find-if #'(lambda (ttl)
1986 (curpos (line-beginning-position)) 1918 (< (rst-Ttl-contains ttl (point)) 0))
1987 prev) 1919 (rst-all-ttls)
1988 1920 :from-end t)))
1989 ;; Search for the adornments around the current line.
1990 (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) curpos))
1991 (setq prev (car ttls)
1992 ttls (cdr ttls)))
1993 (and prev (rst-Ttl-hdr prev)))) 1921 (and prev (rst-Ttl-hdr prev))))
1994 1922
1995(defun rst-adornment-complete-p (ado indent) 1923(defun rst-adornment-complete-p (ado indent)
1996 "Return true if the adornment ADO around point is complete using INDENT. 1924 ;; testcover: ok.
1925 "Return t if the adornment ADO around point is complete using INDENT.
1997The adornment is complete if it is a completely correct 1926The adornment is complete if it is a completely correct
1998reStructuredText adornment for the title line at point. This 1927reStructuredText adornment for the title line at point. This
1999includes indentation and correct length of adornment lines." 1928includes indentation and correct length of adornment lines."
2000 ;; Note: we assume that the detection of the overline as being the underline 1929 ;; Note: we assume that the detection of the overline as being the underline
2001 ;; of a preceding title has already been detected, and has been eliminated 1930 ;; of a preceding title has already been detected, and has been eliminated
2002 ;; from the adornment that is given to us. 1931 ;; from the adornment that is given to us.
2003 (let ((exps (rst-re "^" (rst-Ado-char ado) 1932 (let ((exps (list "^" (rst-Ado-char ado)
2004 (format "\\{%d\\}" 1933 (format "\\{%d\\}"
2005 (+ (save-excursion 1934 (+ (save-excursion
2006 ;; Determine last column of title. 1935 ;; Determine last column of title.
2007 (end-of-line) 1936 (end-of-line)
2008 (current-column)) 1937 (current-column))
2009 indent)) "$"))) 1938 indent)) "$")))
2010 (and 1939 (and (rst-forward-line-looking-at +1 exps)
2011 (save-excursion (forward-line +1) 1940 (or (rst-Ado-is-simple ado)
2012 (looking-at exps)) 1941 (rst-forward-line-looking-at -1 exps))
2013 (or (rst-Ado-is-simple ado) 1942 t))) ; Normalize return value.
2014 (save-excursion (forward-line -1)
2015 (looking-at exps))))))
2016 1943
2017(defun rst-next-hdr (hdr hier prev down) 1944(defun rst-next-hdr (hdr hier prev down)
2018 ;; testcover: ok. 1945 ;; testcover: ok.
@@ -2042,6 +1969,7 @@ HIER is nil."
2042 1969
2043;; FIXME: A line "``/`` full" is not accepted as a section title. 1970;; FIXME: A line "``/`` full" is not accepted as a section title.
2044(defun rst-adjust (pfxarg) 1971(defun rst-adjust (pfxarg)
1972 ;; testcover: ok.
2045 "Auto-adjust the adornment around point. 1973 "Auto-adjust the adornment around point.
2046Adjust/rotate the section adornment for the section title around 1974Adjust/rotate the section adornment for the section title around
2047point or promote/demote the adornments inside the region, 1975point or promote/demote the adornments inside the region,
@@ -2056,7 +1984,7 @@ to deal with all the possible cases gracefully and to do \"the
2056right thing\" in all cases. 1984right thing\" in all cases.
2057 1985
2058See the documentations of `rst-adjust-section' and 1986See the documentations of `rst-adjust-section' and
2059`rst-promote-region' for full details. 1987`rst-adjust-region' for full details.
2060 1988
2061The method can take either (but not both) of 1989The method can take either (but not both) of
2062 1990
@@ -2067,28 +1995,18 @@ b. a negative numerical argument, which generally inverts the
2067 direction of search in the file or hierarchy. Invoke with C-- 1995 direction of search in the file or hierarchy. Invoke with C--
2068 prefix for example." 1996 prefix for example."
2069 (interactive "P") 1997 (interactive "P")
2070 1998 (let* ((origpt (point-marker))
2071 (let* (;; Save our original position on the current line.
2072 (origpt (point-marker))
2073
2074 (reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0))) 1999 (reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0)))
2075 (toggle-style (and pfxarg (not reverse-direction)))) 2000 (toggle-style (and pfxarg (not reverse-direction))))
2076
2077 (if (use-region-p) 2001 (if (use-region-p)
2078 ;; Adjust adornments within region. 2002 (rst-adjust-region (and pfxarg t))
2079 (rst-promote-region (and pfxarg t))
2080 ;; Adjust adornment around point.
2081 (let ((msg (rst-adjust-section toggle-style reverse-direction))) 2003 (let ((msg (rst-adjust-section toggle-style reverse-direction)))
2082 (when msg 2004 (when msg
2083 (apply 'message msg)))) 2005 (apply #'message msg))))
2084
2085 ;; Run the hooks to run after adjusting.
2086 (run-hooks 'rst-adjust-hook) 2006 (run-hooks 'rst-adjust-hook)
2087
2088 (rst-reset-section-caches) 2007 (rst-reset-section-caches)
2089 2008 (set-marker
2090 ;; Make sure to reset the cursor position properly after we're done. 2009 (goto-char origpt) nil)))
2091 (goto-char origpt)))
2092 2010
2093(defcustom rst-adjust-hook nil 2011(defcustom rst-adjust-hook nil
2094 "Hooks to be run after running `rst-adjust'." 2012 "Hooks to be run after running `rst-adjust'."
@@ -2116,8 +2034,77 @@ Argument PFXARG has the same meaning as for `rst-adjust'."
2116 (toggle-style (and pfxarg (not reverse-direction)))) 2034 (toggle-style (and pfxarg (not reverse-direction))))
2117 (rst-adjust-section toggle-style reverse-direction))) 2035 (rst-adjust-section toggle-style reverse-direction)))
2118 2036
2037(defun rst-adjust-new-hdr (toggle-style reverse ttl)
2038 ;; testcover: ok.
2039 "Return a new `rst-Hdr' for `rst-adjust-section' related to TTL.
2040TOGGLE-STYLE and REVERSE are from
2041`rst-adjust-section'. TOGGLE-STYLE may be consumed and thus is
2042returned.
2043
2044Return a list (HDR TOGGLE-STYLE MSG...). HDR is the result or
2045nil. TOGGLE-STYLE is the new TOGGLE-STYLE to use in the
2046caller. MSG is a list which is non-empty in case HDR is nil
2047giving an argument list for `message'."
2048 (save-excursion
2049 (goto-char (rst-Ttl-get-title-beginning ttl))
2050 (let ((indent (rst-Ttl-indent ttl))
2051 (ado (rst-Ttl-ado ttl))
2052 (prev (rst-get-previous-hdr))
2053 hdr-msg)
2054 (setq
2055 hdr-msg
2056 (cond
2057 ((rst-Ttl-is-candidate ttl)
2058 ;; Case 1: No adornment at all.
2059 (let ((hier (rst-hdr-hierarchy)))
2060 (if prev
2061 ;; Previous header exists - use it.
2062 (cond
2063 ;; Customization and parameters require that the previous level
2064 ;; is used - use it as is.
2065 ((or (and rst-new-adornment-down reverse)
2066 (and (not rst-new-adornment-down) (not reverse)))
2067 prev)
2068 ;; Advance one level down.
2069 ((rst-next-hdr prev hier prev t))
2070 ("Neither hierarchy nor preferences can suggest a deeper header"))
2071 ;; First header in the buffer - use the first adornment from
2072 ;; preferences or hierarchy.
2073 (let ((p (car (rst-Hdr-preferred-adornments)))
2074 (h (car hier)))
2075 (cond
2076 ((if reverse
2077 ;; Prefer hierarchy for downwards
2078 (or h p)
2079 ;; Prefer preferences for upwards
2080 (or p h)))
2081 ("No preferences to suggest a top level from"))))))
2082 ((not (rst-adornment-complete-p ado indent))
2083 ;; Case 2: Incomplete adornment.
2084 ;; Use lax since indentation might not match suggestion.
2085 (rst-Hdr-new-lax ado indent))
2086 ;; Case 3: Complete adornment exists from here on.
2087 (toggle-style
2088 ;; Simply switch the style of the current adornment.
2089 (setq toggle-style nil) ; Remember toggling has been done.
2090 (rst-Hdr-new-invert ado rst-default-indent))
2091 (t
2092 ;; Rotate, ignoring a sole adornment around the current line.
2093 (let ((hier (rst-hdr-hierarchy (point))))
2094 (cond
2095 ;; Next header can be determined from hierarchy or preferences.
2096 ((rst-next-hdr
2097 ;; Use lax since indentation might not match suggestion.
2098 (rst-Hdr-new-lax ado indent) hier prev reverse))
2099 ;; No next header found.
2100 ("No preferences or hierarchy to suggest another level from"))))))
2101 (if (stringp hdr-msg)
2102 (list nil toggle-style hdr-msg)
2103 (list hdr-msg toggle-style)))))
2104
2119(defun rst-adjust-section (toggle-style reverse) 2105(defun rst-adjust-section (toggle-style reverse)
2120"Adjust/rotate the section adornment for the section title around point. 2106 ;; testcover: ok.
2107 "Adjust/rotate the section adornment for the section title around point.
2121The action this function takes depends on context around the 2108The action this function takes depends on context around the
2122point, and it is meant to be invoked possibly more than once to 2109point, and it is meant to be invoked possibly more than once to
2123rotate among the various possibilities. Basically, this function 2110rotate among the various possibilities. Basically, this function
@@ -2191,135 +2178,71 @@ around the cursor. Then the following cases are distinguished.
2191 However, if TOGGLE-STYLE, we do not rotate the adornment, but instead simply 2178 However, if TOGGLE-STYLE, we do not rotate the adornment, but instead simply
2192 toggle the style of the current adornment." 2179 toggle the style of the current adornment."
2193 (rst-reset-section-caches) 2180 (rst-reset-section-caches)
2194 (let ((ttl (rst-ttl-at-point)) 2181 (let ((ttl (rst-ttl-at-point)))
2195 (orig-pnt (point))
2196 msg)
2197 (if (not ttl) 2182 (if (not ttl)
2198 (setq msg '("No section header or candidate at point")) 2183 '("No section header or candidate at point")
2199 (goto-char (rst-Ttl-get-title-beginning ttl)) 2184 (cl-destructuring-bind
2200 (let ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt))) 2185 (hdr toggle-style &rest msg
2201 (found (rst-Ttl-ado ttl)) 2186 &aux
2202 (indent (rst-Ttl-indent ttl)) 2187 (indent (rst-Ttl-indent ttl))
2203 (prev (rst-get-previous-hdr)) 2188 (moved (- (line-number-at-pos (rst-Ttl-get-title-beginning ttl))
2204 new) 2189 (line-number-at-pos))))
2205 (when (and found (not (rst-Ado-p found))) 2190 (rst-adjust-new-hdr toggle-style reverse ttl)
2206 ;; Normalize found adornment - overline with no underline counts as 2191 (if msg
2207 ;; overline. 2192 msg
2208 (setq found (rst-Ado-new-over-and-under found)))
2209 (setq new
2210 (cond
2211 ((not found)
2212 ;; Case 1: No adornment at all.
2213 (let ((hier (rst-hdr-hierarchy)))
2214 (if prev
2215 ;; Previous header exists - use it.
2216 (cond
2217 ;; Customization and parameters require that the
2218 ;; previous level is used - use it as is.
2219 ((or (and rst-new-adornment-down reverse)
2220 (and (not rst-new-adornment-down) (not reverse)))
2221 prev)
2222 ;; Advance one level down.
2223 ((rst-next-hdr prev hier prev t))
2224 (t
2225 (setq msg '("Neither hierarchy nor preferences can suggest a deeper header"))
2226 nil))
2227 ;; First header in the buffer - use the first adornment
2228 ;; from preferences or hierarchy.
2229 (let ((p (car (rst-Hdr-preferred-adornments)))
2230 (h (car hier)))
2231 (cond
2232 ((if reverse
2233 ;; Prefer hierarchy for downwards
2234 (or h p)
2235 ;; Prefer preferences for upwards
2236 (or p h)))
2237 (t
2238 (setq msg '("No preferences to suggest a top level from"))
2239 nil))))))
2240 ((not (rst-adornment-complete-p found indent))
2241 ;; Case 2: Incomplete adornment.
2242 ;; Use lax since indentation might not match suggestion.
2243 (rst-Hdr-new-lax found indent))
2244 ;; Case 3: Complete adornment exists from here on.
2245 (toggle-style
2246 ;; Simply switch the style of the current adornment.
2247 (setq toggle-style nil) ;; Remember toggling has been done.
2248 (rst-Hdr-new-invert found rst-default-indent))
2249 (t
2250 ;; Rotate, ignoring a sole adornment around the current line.
2251 (let ((hier (rst-hdr-hierarchy t)))
2252 (cond
2253 ;; Next header can be determined from hierarchy or
2254 ;; preferences.
2255 ((rst-next-hdr
2256 ;; Use lax since indentation might not match suggestion.
2257 (rst-Hdr-new-lax found indent) hier prev reverse))
2258 ;; No next header found.
2259 (t
2260 (setq msg '("No preferences or hierarchy to suggest another level from"))
2261 nil))))))
2262 (if (not new)
2263 (goto-char orig-pnt)
2264 (when toggle-style 2193 (when toggle-style
2265 (setq new (rst-Hdr-new-invert (rst-Hdr-ado new) indent))) 2194 (setq hdr (rst-Hdr-new-invert (rst-Hdr-ado hdr) indent)))
2266 ;; Override indent with present indent if there is some. 2195 ;; Override indent with present indent if there is some.
2267 (when (> indent 0) 2196 (when (> indent 0)
2268 ;; Use lax since existing indent may not be valid for new style. 2197 ;; Use lax since existing indent may not be valid for new style.
2269 (setq new (rst-Hdr-new-lax (rst-Hdr-ado new) indent))) 2198 (setq hdr (rst-Hdr-new-lax (rst-Hdr-ado hdr) indent)))
2270 (rst-update-section new) 2199 (goto-char (rst-Ttl-get-title-beginning ttl))
2271 ;; Correct the position of the cursor to more accurately reflect where 2200 (rst-update-section hdr)
2272 ;; it was located when the function was invoked. 2201 ;; Correct the position of the cursor to more accurately reflect
2202 ;; where it was located when the function was invoked.
2273 (unless (zerop moved) 2203 (unless (zerop moved)
2274 (forward-line (- moved)) 2204 (1value ; No lines may be left to move.
2275 (end-of-line))))) 2205 (rst-forward-line-strict (- moved)))
2276 msg)) 2206 (end-of-line))
2207 nil)))))
2277 2208
2278;; Maintain an alias for compatibility. 2209;; Maintain an alias for compatibility.
2279(defalias 'rst-adjust-section-title 'rst-adjust) 2210(defalias 'rst-adjust-section-title 'rst-adjust)
2280 2211
2281(defun rst-promote-region (demote) 2212(defun rst-adjust-region (demote)
2213 ;; testcover: ok.
2282 "Promote the section titles within the region. 2214 "Promote the section titles within the region.
2283With argument DEMOTE or a prefix argument, demote the section 2215With argument DEMOTE or a prefix argument, demote the section
2284titles instead. The algorithm used at the boundaries of the 2216titles instead. The algorithm used at the boundaries of the
2285hierarchy is similar to that used by `rst-adjust-section'." 2217hierarchy is similar to that used by `rst-adjust-section'."
2286 (interactive "P") 2218 (interactive "P")
2287 (rst-reset-section-caches) 2219 (rst-reset-section-caches)
2288 (let ((ttls (rst-all-ttls)) 2220 (let* ((beg (region-beginning))
2289 (hier (rst-hdr-hierarchy)) 2221 (end (region-end))
2290 (region-beg (save-excursion 2222 (ttls-reg (cl-remove-if-not
2291 (goto-char (region-beginning)) 2223 #'(lambda (ttl)
2292 (line-beginning-position))) 2224 (and
2293 (region-end (save-excursion 2225 (>= (rst-Ttl-contains ttl beg) 0)
2294 (goto-char (region-end)) 2226 (< (rst-Ttl-contains ttl end) 0)))
2295 (line-beginning-position))) 2227 (rst-all-ttls))))
2296 marker-list)
2297
2298 ;; Skip the markers that come before the region beginning.
2299 (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) region-beg))
2300 (setq ttls (cdr ttls)))
2301
2302 ;; Create a list of markers for all the adornments which are found within
2303 ;; the region.
2304 (save-excursion 2228 (save-excursion
2305 (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) region-end))
2306 (push (cons (copy-marker (rst-Ttl-get-title-beginning (car ttls)))
2307 (rst-Ttl-hdr (car ttls))) marker-list)
2308 (setq ttls (cdr ttls)))
2309
2310 ;; Apply modifications. 2229 ;; Apply modifications.
2311 (dolist (p marker-list) 2230 (rst-destructuring-dolist
2312 ;; Go to the adornment to promote. 2231 ((marker &rest hdr
2313 (goto-char (car p)) 2232 &aux (hier (rst-hdr-hierarchy)))
2233 (mapcar #'(lambda (ttl)
2234 (cons (copy-marker (rst-Ttl-get-title-beginning ttl))
2235 (rst-Ttl-hdr ttl)))
2236 ttls-reg))
2237 (set-marker
2238 (goto-char marker) nil)
2314 ;; `rst-next-hdr' cannot return nil because we apply to a section 2239 ;; `rst-next-hdr' cannot return nil because we apply to a section
2315 ;; header so there is some hierarchy. 2240 ;; header so there is some hierarchy.
2316 (rst-update-section (rst-next-hdr (cdr p) hier nil demote)) 2241 (rst-update-section (rst-next-hdr hdr hier nil demote)))
2317
2318 ;; Clear marker to avoid slowing down the editing after we're done.
2319 (set-marker (car p) nil))
2320 (setq deactivate-mark nil)))) 2242 (setq deactivate-mark nil))))
2321 2243
2322(defun rst-display-hdr-hierarchy () 2244(defun rst-display-hdr-hierarchy ()
2245 ;; testcover: ok.
2323 "Display the current file's section title adornments hierarchy. 2246 "Display the current file's section title adornments hierarchy.
2324Hierarchy is displayed in a temporary buffer." 2247Hierarchy is displayed in a temporary buffer."
2325 (interactive) 2248 (interactive)
@@ -2333,7 +2256,7 @@ Hierarchy is displayed in a temporary buffer."
2333 (rst-update-section hdr) 2256 (rst-update-section hdr)
2334 (goto-char (point-max)) 2257 (goto-char (point-max))
2335 (insert "\n") 2258 (insert "\n")
2336 (incf level)))))) 2259 (cl-incf level))))))
2337 2260
2338;; Maintain an alias for backward compatibility. 2261;; Maintain an alias for backward compatibility.
2339(defalias 'rst-display-adornments-hierarchy 'rst-display-hdr-hierarchy) 2262(defalias 'rst-display-adornments-hierarchy 'rst-display-hdr-hierarchy)
@@ -2341,6 +2264,7 @@ Hierarchy is displayed in a temporary buffer."
2341;; FIXME: Should accept an argument giving the hierarchy level to start with 2264;; FIXME: Should accept an argument giving the hierarchy level to start with
2342;; instead of the top of the hierarchy. 2265;; instead of the top of the hierarchy.
2343(defun rst-straighten-sections () 2266(defun rst-straighten-sections ()
2267 ;; testcover: ok.
2344 "Redo the adornments of all section titles in the current buffer. 2268 "Redo the adornments of all section titles in the current buffer.
2345This is done using the preferred set of adornments. This can be 2269This is done using the preferred set of adornments. This can be
2346used, for example, when using somebody else's copy of a document, 2270used, for example, when using somebody else's copy of a document,
@@ -2348,17 +2272,17 @@ in order to adapt it to our preferred style."
2348 (interactive) 2272 (interactive)
2349 (rst-reset-section-caches) 2273 (rst-reset-section-caches)
2350 (save-excursion 2274 (save-excursion
2351 (dolist (ttl-marker (mapcar 2275 (rst-destructuring-dolist
2352 (lambda (ttl) 2276 ((marker &rest level)
2353 (cons ttl (copy-marker 2277 (mapcar
2354 (rst-Ttl-get-title-beginning ttl)))) 2278 (cl-function
2355 (rst-all-ttls-with-level))) 2279 (lambda ((ttl &rest level))
2356 ;; Go to the appropriate position. 2280 ;; Use markers so edits don't disturb the position.
2357 (goto-char (cdr ttl-marker)) 2281 (cons (copy-marker (rst-Ttl-get-title-beginning ttl)) level)))
2358 (rst-update-section (nth (rst-Ttl-level (car ttl-marker)) 2282 (rst-all-ttls-with-level)))
2359 (rst-Hdr-preferred-adornments))) 2283 (set-marker
2360 ;; Reset the marker to avoid slowing down editing. 2284 (goto-char marker) nil)
2361 (set-marker (cdr ttl-marker) nil)))) 2285 (rst-update-section (nth level (rst-Hdr-preferred-adornments))))))
2362 2286
2363;; Maintain an alias for compatibility. 2287;; Maintain an alias for compatibility.
2364(defalias 'rst-straighten-adornments 'rst-straighten-sections) 2288(defalias 'rst-straighten-adornments 'rst-straighten-sections)
@@ -2367,9 +2291,9 @@ in order to adapt it to our preferred style."
2367;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2291;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2368;; Insert list items 2292;; Insert list items
2369 2293
2370; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <wence@gmx.li>. 2294;; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <wence@gmx.li>. I
2371; I needed to make some tiny changes to the functions, so I put it here. 2295;; needed to make some tiny changes to the functions, so I put it here.
2372; -- Wei-Wei Guo 2296;; -- Wei-Wei Guo
2373 2297
2374(defconst rst-arabic-to-roman 2298(defconst rst-arabic-to-roman
2375 '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") 2299 '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD")
@@ -2378,73 +2302,59 @@ in order to adapt it to our preferred style."
2378 (1 . "I")) 2302 (1 . "I"))
2379 "List of maps between Arabic numbers and their Roman numeral equivalents.") 2303 "List of maps between Arabic numbers and their Roman numeral equivalents.")
2380 2304
2381(defun rst-arabic-to-roman (num &optional arg) 2305(defun rst-arabic-to-roman (num)
2306 ;; testcover: ok.
2382 "Convert Arabic number NUM to its Roman numeral representation. 2307 "Convert Arabic number NUM to its Roman numeral representation.
2383 2308
2384Obviously, NUM must be greater than zero. Don't blame me, blame the 2309Obviously, NUM must be greater than zero. Don't blame me, blame the
2385Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with 2310Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with
2386apologies to Monty Python). 2311apologies to Monty Python)."
2387If optional ARG is non-nil, insert in current buffer." 2312 (cl-check-type num (integer 1 *))
2388 (let ((map rst-arabic-to-roman) 2313 (let ((map rst-arabic-to-roman)
2389 res) 2314 (r ""))
2390 (while (and map (> num 0)) 2315 (while (and map (> num 0))
2391 (if (or (= num (caar map)) 2316 (cl-destructuring-bind ((val &rest sym) &rest next) map
2392 (> num (caar map))) 2317 (if (>= num val)
2393 (setq res (concat res (cdar map)) 2318 (setq r (concat r sym)
2394 num (- num (caar map))) 2319 num (- num val))
2395 (setq map (cdr map)))) 2320 (setq map next))))
2396 (if arg (insert (or res "")) res))) 2321 r))
2397 2322
2398(defun rst-roman-to-arabic (string &optional arg) 2323(defun rst-roman-to-arabic (string)
2324 ;; testcover: ok.
2399 "Convert STRING of Roman numerals to an Arabic number. 2325 "Convert STRING of Roman numerals to an Arabic number.
2400
2401If STRING contains a letter which isn't a valid Roman numeral, 2326If STRING contains a letter which isn't a valid Roman numeral,
2402the rest of the string from that point onwards is ignored. 2327the rest of the string from that point onwards is ignored.
2403
2404Hence: 2328Hence:
2405MMD == 2500 2329MMD == 2500
2406and 2330and
2407MMDFLXXVI == 2500. 2331MMDFLXXVI == 2500."
2408If optional ARG is non-nil, insert in current buffer." 2332 (cl-check-type string string)
2333 (cl-check-type string (satisfies (lambda (s)
2334 (not (equal s ""))))
2335 "Roman number may not be an empty string.")
2409 (let ((res 0) 2336 (let ((res 0)
2410 (map rst-arabic-to-roman)) 2337 (map rst-arabic-to-roman))
2411 (while map 2338 (save-match-data
2412 (if (string-match (concat "^" (cdar map)) string) 2339 (while map
2413 (setq res (+ res (caar map)) 2340 (cl-destructuring-bind ((val &rest sym) &rest next) map
2414 string (replace-match "" nil t string)) 2341 (if (string-match (concat "^" sym) string)
2415 (setq map (cdr map)))) 2342 (setq res (+ res val)
2416 (if arg (insert res) res))) 2343 string (replace-match "" nil t string))
2344 (setq map next))))
2345 (cl-check-type string (satisfies (lambda (s)
2346 (equal s "")))
2347 "Invalid characters in roman number")
2348 res)))
2417 2349
2418;; End of borrow. 2350;; End of borrow.
2419 2351
2420(defun rst-find-pfx-in-region (beg end pfx-re) 2352;; FIXME: All the following code should not consider single lines as items but
2421 "Find all the positions of prefixes in region between BEG and END. 2353;; paragraphs as reST does.
2422This is used to find bullets and enumerated list items. PFX-RE is 2354
2423a regular expression for matching the lines after indentation 2355(defun rst-insert-list-new-tag (tag)
2424with items. Returns a list of cons cells consisting of the point 2356 ;; testcover: ok.
2425and the column of the point." 2357 "Insert first item of a new list tagged with TAG.
2426 (let ((pfx ()))
2427 (save-excursion
2428 (goto-char beg)
2429 (while (< (point) end)
2430 (back-to-indentation)
2431 (when (and
2432 (looking-at pfx-re) ; pfx found and...
2433 (let ((pfx-col (current-column)))
2434 (save-excursion
2435 (forward-line -1) ; ...previous line is...
2436 (back-to-indentation)
2437 (or (looking-at (rst-re 'lin-end)) ; ...empty,
2438 (> (current-column) pfx-col) ; ...deeper level, or
2439 (and (= (current-column) pfx-col)
2440 (looking-at pfx-re)))))) ; ...pfx at same level.
2441 (push (cons (point) (current-column))
2442 pfx))
2443 (forward-line 1)))
2444 (nreverse pfx)))
2445
2446(defun rst-insert-list-pos (newitem)
2447 "Arrange relative position of a newly inserted list item of style NEWITEM.
2448 2358
2449Adding a new list might consider three situations: 2359Adding a new list might consider three situations:
2450 2360
@@ -2460,45 +2370,42 @@ When not (a), first forward point to the end of the line, and add two
2460blank lines, then add the new list. 2370blank lines, then add the new list.
2461 2371
2462Other situations are just ignored and left to users themselves." 2372Other situations are just ignored and left to users themselves."
2463 (if (save-excursion 2373 ;; FIXME: Following line is not considered at all.
2464 (beginning-of-line) 2374 (let ((pfx-nls
2465 (looking-at (rst-re 'lin-end))) 2375 ;; FIXME: Doesn't work properly for white-space line. See
2466 (if (save-excursion 2376 ;; `rst-insert-list-new-BUGS'.
2467 (forward-line -1) 2377 (if (rst-forward-line-looking-at 0 'lin-end)
2468 (looking-at (rst-re 'lin-end))) 2378 (if (not (rst-forward-line-looking-at -1 'lin-end #'not))
2469 (insert newitem " ") 2379 0
2470 (insert "\n" newitem " ")) 2380 1)
2381 2)))
2471 (end-of-line) 2382 (end-of-line)
2472 (insert "\n\n" newitem " "))) 2383 ;; FIXME: The indentation is not fixed to a single space by the syntax. May
2473 2384 ;; be this should be configurable or rather taken from the context.
2474;; FIXME: Isn't this a `defconst'? 2385 (insert (make-string pfx-nls ?\n) tag " ")))
2475(defvar rst-initial-enums 2386
2476 (let (vals) 2387(defconst rst-initial-items
2477 (dolist (fmt '("%s." "(%s)" "%s)")) 2388 (append (mapcar #'char-to-string rst-bullets)
2478 (dolist (c '("1" "a" "A" "I" "i")) 2389 (let (vals)
2479 (push (format fmt c) vals))) 2390 (dolist (fmt '("%s." "(%s)" "%s)"))
2480 (cons "#." (nreverse vals))) 2391 (dolist (c '("#" "1" "a" "A" "I" "i"))
2481 "List of initial enumerations.") 2392 (push (format fmt c) vals)))
2482 2393 (nreverse vals)))
2483;; FIXME: Isn't this a `defconst'?
2484(defvar rst-initial-items
2485 (append (mapcar 'char-to-string rst-bullets) rst-initial-enums)
2486 "List of initial items. It's a collection of bullets and enumerations.") 2394 "List of initial items. It's a collection of bullets and enumerations.")
2487 2395
2488(defun rst-insert-list-new-item () 2396(defun rst-insert-list-new-item ()
2397 ;; testcover: ok.
2489 "Insert a new list item. 2398 "Insert a new list item.
2490 2399
2491User is asked to select the item style first, for example (a), i), +. 2400User is asked to select the item style first, for example (a), i), +.
2492Use TAB for completion and choices. 2401Use TAB for completion and choices.
2493 2402
2494If user selects bullets or #, it's just added with position arranged by 2403If user selects bullets or #, it's just added with position arranged by
2495`rst-insert-list-pos'. 2404`rst-insert-list-new-tag'.
2496 2405
2497If user selects enumerations, a further prompt is given. User need to 2406If user selects enumerations, a further prompt is given. User need to
2498input a starting item, for example 'e' for 'A)' style. The position is 2407input a starting item, for example 'e' for 'A)' style. The position is
2499also arranged by `rst-insert-list-pos'." 2408also arranged by `rst-insert-list-new-tag'."
2500 (interactive)
2501 ;; FIXME: Make this comply to `interactive' standards.
2502 (let* ((itemstyle (completing-read 2409 (let* ((itemstyle (completing-read
2503 "Select preferred item style [#.]: " 2410 "Select preferred item style [#.]: "
2504 rst-initial-items nil t nil nil "#.")) 2411 rst-initial-items nil t nil nil "#."))
@@ -2506,7 +2413,6 @@ also arranged by `rst-insert-list-pos'."
2506 (match-string 0 itemstyle))) 2413 (match-string 0 itemstyle)))
2507 (no 2414 (no
2508 (save-match-data 2415 (save-match-data
2509 ;; FIXME: Make this comply to `interactive' standards.
2510 (cond 2416 (cond
2511 ((equal cnt "a") 2417 ((equal cnt "a")
2512 (let ((itemno (read-string "Give starting value [a]: " 2418 (let ((itemno (read-string "Give starting value [a]: "
@@ -2527,66 +2433,73 @@ also arranged by `rst-insert-list-pos'."
2527 (number-to-string itemno))))))) 2433 (number-to-string itemno)))))))
2528 (if no 2434 (if no
2529 (setq itemstyle (replace-match no t t itemstyle))) 2435 (setq itemstyle (replace-match no t t itemstyle)))
2530 (rst-insert-list-pos itemstyle))) 2436 (rst-insert-list-new-tag itemstyle)))
2531 2437
2532(defcustom rst-preferred-bullets 2438(defcustom rst-preferred-bullets
2533 '(?* ?- ?+) 2439 '(?* ?- ?+)
2534 "List of favorite bullets." 2440 "List of favorite bullets."
2535 :group 'rst 2441 :group 'rst
2536 :type `(repeat 2442 :type `(repeat
2537 (choice ,@(mapcar (lambda (char) 2443 (choice ,@(mapcar #'(lambda (char)
2538 (list 'const 2444 (list 'const
2539 :tag (char-to-string char) char)) 2445 :tag (char-to-string char) char))
2540 rst-bullets))) 2446 rst-bullets)))
2541 :package-version '(rst . "1.1.0")) 2447 :package-version '(rst . "1.1.0"))
2542(rst-testcover-defcustom) 2448(rst-testcover-defcustom)
2543 2449
2544(defun rst-insert-list-continue (curitem prefer-roman) 2450(defun rst-insert-list-continue (ind tag tab prefer-roman)
2545 "Insert a list item with list start CURITEM including its indentation level. 2451 ;; testcover: ok.
2546If PREFER-ROMAN roman numbering is preferred over using letters." 2452 "Insert a new list tag after the current line according to style.
2453Style is defined by indentation IND, TAG and suffix TAB. If
2454PREFER-ROMAN roman numbering is preferred over using letters."
2547 (end-of-line) 2455 (end-of-line)
2548 (insert 2456 (insert
2549 "\n" ; FIXME: Separating lines must be possible. 2457 ;; FIXME: Separating lines must be possible.
2550 (cond 2458 "\n"
2551 ((string-match (rst-re '(:alt enmaut-tag 2459 ind
2552 bul-tag)) curitem) 2460 (save-match-data
2553 curitem) 2461 (if (not (string-match (rst-re 'cntexp-tag) tag))
2554 ((string-match (rst-re 'num-tag) curitem) 2462 tag
2555 (replace-match (number-to-string 2463 (let ((pfx (substring tag 0 (match-beginning 0)))
2556 (1+ (string-to-number (match-string 0 curitem)))) 2464 (cnt (match-string 0 tag))
2557 nil nil curitem)) 2465 (sfx (substring tag (match-end 0))))
2558 ((and (string-match (rst-re 'rom-tag) curitem) 2466 (concat
2559 (save-match-data 2467 pfx
2560 (if (string-match (rst-re 'ltr-tag) curitem) ; Also a letter tag. 2468 (cond
2561 (save-excursion 2469 ((string-match (rst-re 'num-tag) cnt)
2562 ;; FIXME: Assumes one line list items without separating 2470 (number-to-string (1+ (string-to-number (match-string 0 cnt)))))
2563 ;; empty lines. 2471 ((and
2564 (if (and (zerop (forward-line -1)) 2472 (string-match (rst-re 'rom-tag) cnt)
2565 (looking-at (rst-re 'enmexp-beg))) 2473 (save-match-data
2566 (string-match 2474 (if (string-match (rst-re 'ltr-tag) cnt) ; Also a letter tag.
2567 (rst-re 'rom-tag) 2475 (save-excursion
2568 (match-string 0)) ; Previous was a roman tag. 2476 ;; FIXME: Assumes one line list items without separating
2569 prefer-roman)) ; Don't know - use flag. 2477 ;; empty lines.
2570 t))) ; Not a letter tag. 2478 ;; Use of `rst-forward-line-looking-at' is very difficult
2571 (replace-match 2479 ;; here so don't do it.
2572 (let* ((old (match-string 0 curitem)) 2480 (if (and (rst-forward-line-strict -1)
2573 (new (save-match-data 2481 (looking-at (rst-re 'enmexp-beg)))
2574 (rst-arabic-to-roman 2482 (string-match
2575 (1+ (rst-roman-to-arabic 2483 (rst-re 'rom-tag)
2576 (upcase old))))))) 2484 (match-string 0)) ; Previous was a roman tag.
2577 (if (equal old (upcase old)) 2485 prefer-roman)) ; Don't know - use flag.
2578 (upcase new) 2486 t))) ; Not a letter tag.
2579 (downcase new))) 2487 (let* ((old (match-string 0 cnt))
2580 t nil curitem)) 2488 (new (rst-arabic-to-roman
2581 ((string-match (rst-re 'ltr-tag) curitem) 2489 (1+ (rst-roman-to-arabic (upcase old))))))
2582 (replace-match (char-to-string 2490 (if (equal old (upcase old))
2583 (1+ (string-to-char (match-string 0 curitem)))) 2491 (upcase new)
2584 nil nil curitem))))) 2492 (downcase new))))
2493 ((string-match (rst-re 'ltr-tag) cnt)
2494 (char-to-string (1+ (string-to-char (match-string 0 cnt))))))
2495 sfx))))
2496 tab))
2585 2497
2586;; FIXME: At least the continuation may be folded into 2498;; FIXME: At least the continuation may be folded into
2587;; `newline-and-indent`. However, this may not be wanted by everyone so 2499;; `newline-and-indent`. However, this may not be wanted by everyone so
2588;; it should be possible to switch this off. 2500;; it should be possible to switch this off.
2589(defun rst-insert-list (&optional prefer-roman) 2501(defun rst-insert-list (&optional prefer-roman)
2502 ;; testcover: ok.
2590 "Insert a list item at the current point. 2503 "Insert a list item at the current point.
2591 2504
2592The command can insert a new list or a continuing list. When it is called at a 2505The command can insert a new list or a continuing list. When it is called at a
@@ -2614,84 +2527,135 @@ preceded by a blank line, it is hard to determine which type to use
2614automatically. The function uses alphabetical list by default. If you want 2527automatically. The function uses alphabetical list by default. If you want
2615roman numerical list, just use a prefix to set PREFER-ROMAN." 2528roman numerical list, just use a prefix to set PREFER-ROMAN."
2616 (interactive "P") 2529 (interactive "P")
2617 (beginning-of-line) 2530 (save-match-data
2618 (if (looking-at (rst-re 'itmany-beg-1)) 2531 (1value
2619 (rst-insert-list-continue (match-string 0) prefer-roman) 2532 (rst-forward-line-strict 0))
2620 (rst-insert-list-new-item))) 2533 ;; FIXME: Finds only tags in single line items. Multi-line items should be
2534 ;; considered as well.
2535 ;; Using `rst-forward-line-looking-at' is more complicated so don't do it.
2536 (if (looking-at (rst-re 'itmany-beg-1))
2537 (rst-insert-list-continue
2538 (buffer-substring-no-properties
2539 (match-beginning 0) (match-beginning 1))
2540 (match-string 1)
2541 (buffer-substring-no-properties (match-end 1) (match-end 0))
2542 prefer-roman)
2543 (rst-insert-list-new-item))))
2544
2545;; FIXME: This is wrong because it misses prefixed lines without intervening
2546;; new line. See `rst-straighten-bullets-region-BUGS' and
2547;; `rst-find-begs-BUGS'.
2548(defun rst-find-begs (beg end rst-re-beg)
2549 ;; testcover: ok.
2550 "Return the positions of begs in region BEG to END.
2551RST-RE-BEG is a `rst-re' argument and matched at the beginning of
2552a line. Return a list of (POINT . COLUMN) where POINT gives the
2553point after indentation and COLUMN gives its column. The list is
2554ordered by POINT."
2555 (let (r)
2556 (save-match-data
2557 (save-excursion
2558 ;; FIXME refactoring: Consider making this construct a macro looping
2559 ;; over the lines.
2560 (goto-char beg)
2561 (1value
2562 (rst-forward-line-strict 0))
2563 (while (< (point) end)
2564 (let ((clm (current-indentation)))
2565 ;; FIXME refactoring: Consider using `rst-forward-line-looking-at'.
2566 (when (and
2567 (looking-at (rst-re rst-re-beg)) ; Start found
2568 (not (rst-forward-line-looking-at
2569 -1 'lin-end
2570 #'(lambda (mtcd) ; Previous line exists and is...
2571 (and
2572 (not mtcd) ; non-empty,
2573 (<= (current-indentation) clm) ; less indented
2574 (not (and (= (current-indentation) clm)
2575 ; not a beg at same level.
2576 (looking-at (rst-re rst-re-beg)))))))))
2577 (back-to-indentation)
2578 (push (cons (point) clm) r)))
2579 (1value ; At least one line is moved in this loop.
2580 (rst-forward-line-strict 1 end)))))
2581 (nreverse r)))
2621 2582
2622(defun rst-straighten-bullets-region (beg end) 2583(defun rst-straighten-bullets-region (beg end)
2623 "Make all the bulleted list items in the region consistent. 2584 ;; testcover: ok.
2624The region is specified between BEG and END. You can use this 2585 "Make all the bulleted list items in the region from BEG to END consistent.
2625after you have merged multiple bulleted lists to make them use 2586Use this after you have merged multiple bulleted lists to make
2626the same/correct/consistent bullet characters. 2587them use the preferred bullet characters given by
2627 2588`rst-preferred-bullets' for each level. If bullets are found on
2628See variable `rst-preferred-bullets' for the list of bullets to 2589levels beyond the `rst-preferred-bullets' list, they are not
2629adjust. If bullets are found on levels beyond the 2590modified."
2630`rst-preferred-bullets' list, they are not modified."
2631 (interactive "r") 2591 (interactive "r")
2632 2592 (save-excursion
2633 (let ((bullets (rst-find-pfx-in-region beg end (rst-re 'bul-sta))) 2593 (let (clm2pnts) ; Map a column to a list of points at this column.
2634 (levtable (make-hash-table :size 4))) 2594 (rst-destructuring-dolist
2635 2595 ((point &rest column
2636 ;; Create a map of levels to list of positions. 2596 &aux (found (assoc column clm2pnts)))
2637 (dolist (x bullets) 2597 (rst-find-begs beg end 'bul-beg))
2638 (let ((key (cdr x))) 2598 (if found
2639 (puthash key 2599 ;;; (push point (cdr found)) ; FIXME: Doesn't work with `testcover'.
2640 (append (gethash key levtable (list)) 2600 (setcdr found (cons point (cdr found))) ; Synonym.
2641 (list (car x))) 2601 (push (list column point) clm2pnts)))
2642 levtable))) 2602 (rst-destructuring-dolist
2643 2603 ((bullet _clm &rest pnts)
2644 ;; Sort this map and create a new map of prefix char and list of positions. 2604 ;; Zip preferred bullets and sorted columns associating a bullet
2645 (let ((poslist ())) ; List of (indent . positions). 2605 ;; with a column and all the points this column is found.
2646 (maphash (lambda (x y) (push (cons x y) poslist)) levtable) 2606 (cl-mapcar #'(lambda (bullet clm2pnt)
2647 2607 (cons bullet clm2pnt))
2648 (let ((bullets rst-preferred-bullets)) 2608 rst-preferred-bullets
2649 (dolist (x (sort poslist 'car-less-than-car)) 2609 (sort clm2pnts #'car-less-than-car)))
2650 (when bullets 2610 ;; Replace the bullets by the preferred ones.
2651 ;; Apply the characters. 2611 (dolist (pnt pnts)
2652 (dolist (pos (cdr x)) 2612 (goto-char pnt)
2653 (goto-char pos) 2613 ;; FIXME: Assumes bullet to replace is a single char.
2654 (delete-char 1) 2614 (delete-char 1)
2655 (insert (string (car bullets)))) 2615 (insert bullet))))))
2656 (setq bullets (cdr bullets))))))))
2657 2616
2658 2617
2659;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2618;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2660;; Table of contents 2619;; Table of contents
2661 2620
2662(defun rst-all-stn () 2621(defun rst-all-stn ()
2663 "Return the hierarchical tree of section titles as a top level `rst-Stn'. 2622 ;; testcover: ok.
2664Return nil for no section titles." 2623 "Return the hierarchical tree of sections as a top level `rst-Stn'.
2665 ;; FIXME: The top level node may contain the document title instead of nil. 2624Return value satisfies `rst-Stn-is-top' or is nil for no
2625sections."
2666 (cdr (rst-remaining-stn (rst-all-ttls-with-level) -1))) 2626 (cdr (rst-remaining-stn (rst-all-ttls-with-level) -1)))
2667 2627
2668(defun rst-remaining-stn (remaining lev) 2628(defun rst-remaining-stn (unprocessed expected)
2669 "Process the first entry of REMAINING expected to be on level LEV. 2629 ;; testcover: ok.
2670REMAINING is the remaining list of `rst-Ttl' entries. 2630 "Process the first entry of UNPROCESSED expected to be on level EXPECTED.
2671Return (UNPROCESSED . NODE) for the first entry of REMAINING. 2631UNPROCESSED is the remaining list of (`rst-Ttl' . LEVEL) entries.
2672UNPROCESSED is the list of still unprocessed entries. NODE is a 2632Return (REMAINING . STN) for the first entry of UNPROCESSED.
2673`rst-Stn' or nil if REMAINING is empty." 2633REMAINING is the list of still unprocessed entries. STN is a
2674 (let ((ttl (car remaining)) 2634`rst-Stn' or nil if UNPROCESSED is empty."
2675 (unprocessed remaining) 2635 (if (not unprocessed)
2676 fnd children) 2636 (1value
2677 ;; If the current adornment matches expected level. 2637 (cons nil nil))
2678 (when (and ttl (= (rst-Ttl-level ttl) lev)) 2638 (cl-destructuring-bind
2679 ;; Consume the current entry and create the current node with it. 2639 ((ttl &rest level) &rest next
2680 (setq unprocessed (cdr remaining)) 2640 &aux fnd children)
2681 (setq fnd ttl)) 2641 unprocessed
2682 ;; Build the child nodes as long as they have deeper level. 2642 (when (= level expected)
2683 (while (and unprocessed (> (rst-Ttl-level (car unprocessed)) lev)) 2643 ;; Consume the current entry and create the current node with it.
2684 (let* ((rem-child (rst-remaining-stn unprocessed (1+ lev))) 2644 (setq fnd ttl)
2685 (child (cdr rem-child))) 2645 (setq unprocessed next))
2686 (when child 2646 ;; Build the child nodes as long as they have deeper level.
2687 (push child children)) 2647 (while (and unprocessed (> (cdar unprocessed) expected))
2688 (setq unprocessed (car rem-child)))) 2648 (cl-destructuring-bind (remaining &rest stn)
2689 (setq children (reverse children)) 2649 (rst-remaining-stn unprocessed (1+ expected))
2690 (cons unprocessed 2650 (when stn
2691 (if (or fnd children) 2651 (push stn children))
2692 (rst-Stn-new fnd lev children))))) 2652 (setq unprocessed remaining)))
2653 (cons unprocessed
2654 (when (or fnd children)
2655 (rst-Stn-new fnd expected (nreverse children)))))))
2693 2656
2694(defun rst-stn-containing-point (stn &optional point) 2657(defun rst-stn-containing-point (stn &optional point)
2658 ;; testcover: ok.
2695 "Return `rst-Stn' in STN before POINT or nil if in no section. 2659 "Return `rst-Stn' in STN before POINT or nil if in no section.
2696POINT defaults to the current point. STN may be nil for no 2660POINT defaults to the current point. STN may be nil for no
2697section headers at all." 2661section headers at all."
@@ -2699,15 +2663,13 @@ section headers at all."
2699 (setq point (or point (point))) 2663 (setq point (or point (point)))
2700 (when (>= point (rst-Stn-get-title-beginning stn)) 2664 (when (>= point (rst-Stn-get-title-beginning stn))
2701 ;; Point may be in this section or a child. 2665 ;; Point may be in this section or a child.
2702 (let ((children (rst-Stn-children stn)) 2666 (let ((in-child (cl-find-if
2703 found) 2667 #'(lambda (child)
2704 (while (and children 2668 (>= point (rst-Stn-get-title-beginning child)))
2705 (>= point (rst-Stn-get-title-beginning (car children)))) 2669 (rst-Stn-children stn)
2706 ;; Point may be in this child. 2670 :from-end t)))
2707 (setq found (car children) 2671 (if in-child
2708 children (cdr children))) 2672 (rst-stn-containing-point in-child point)
2709 (if found
2710 (rst-stn-containing-point found point)
2711 stn))))) 2673 stn)))))
2712 2674
2713(defgroup rst-toc nil 2675(defgroup rst-toc nil
@@ -2729,7 +2691,7 @@ indentation style:
2729- `plain': no numbering (fixed indentation) 2691- `plain': no numbering (fixed indentation)
2730- `fixed': numbering, but fixed indentation 2692- `fixed': numbering, but fixed indentation
2731- `aligned': numbering, titles aligned under each other 2693- `aligned': numbering, titles aligned under each other
2732- `listed': numbering, with dashes like list items (EXPERIMENTAL)" 2694- `listed': titles as list items"
2733 :type '(choice (const plain) 2695 :type '(choice (const plain)
2734 (const fixed) 2696 (const fixed)
2735 (const aligned) 2697 (const aligned)
@@ -2743,143 +2705,204 @@ indentation style:
2743 :group 'rst-toc) 2705 :group 'rst-toc)
2744(rst-testcover-defcustom) 2706(rst-testcover-defcustom)
2745 2707
2746;; FIXME: What does this mean?
2747;; This is used to avoid having to change the user's mode.
2748(defvar rst-toc-insert-click-keymap
2749 (let ((map (make-sparse-keymap)))
2750 (define-key map [mouse-1] 'rst-toc-mode-mouse-goto)
2751 map)
2752 "(Internal) What happens when you click on propertized text in the TOC.")
2753
2754(defcustom rst-toc-insert-max-level nil 2708(defcustom rst-toc-insert-max-level nil
2755 "If non-nil, maximum depth of the inserted TOC." 2709 "If non-nil, maximum depth of the inserted TOC."
2756 :type '(choice (const nil) integer) 2710 :type '(choice (const nil) integer)
2757 :group 'rst-toc) 2711 :group 'rst-toc)
2758(rst-testcover-defcustom) 2712(rst-testcover-defcustom)
2759 2713
2760(defun rst-toc-insert (&optional pfxarg) 2714(defun rst-toc-insert (&optional max-level)
2761 "Insert a text rendering of the table of contents of the current section. 2715 ;; testcover: ok.
2716 "Insert the table of contents of the current section at the current column.
2762By default the top level is ignored if there is only one, because 2717By default the top level is ignored if there is only one, because
2763we assume that the document will have a single title. 2718we assume that the document will have a single title. A numeric
2764 2719prefix argument MAX-LEVEL overrides `rst-toc-insert-max-level'.
2765If a numeric prefix argument PFXARG is given, insert the TOC up 2720Text in the line beyond column is deleted."
2766to the specified level.
2767
2768The TOC is inserted indented at the current column."
2769 (interactive "P") 2721 (interactive "P")
2770 (rst-reset-section-caches) 2722 (rst-reset-section-caches)
2771 (let (;; Check maximum level override. 2723 (let ((pt-stn (rst-stn-containing-point (rst-all-stn))))
2772 (rst-toc-insert-max-level 2724 (when pt-stn
2773 (if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0)) 2725 (let ((max
2774 (prefix-numeric-value pfxarg) rst-toc-insert-max-level)) 2726 (if (and (integerp max-level)
2775 (pt-stn (rst-stn-containing-point (rst-all-stn))) 2727 (> (prefix-numeric-value max-level) 0))
2776 ;; Figure out initial indent. 2728 (prefix-numeric-value max-level)
2777 (initial-indent (make-string (current-column) ? )) 2729 rst-toc-insert-max-level))
2778 (init-point (point))) 2730 (ind (current-column))
2779 (when (and pt-stn (rst-Stn-children pt-stn)) 2731 (buf (current-buffer))
2780 (rst-toc-insert-node pt-stn 0 initial-indent "") 2732 (tabs indent-tabs-mode) ; Copy buffer local value.
2781 ;; FIXME: Really having the last newline would be better. 2733 txt)
2782 ;; Delete the last newline added. 2734 (setq txt
2783 (delete-char -1)))) 2735 ;; Render to temporary buffer so markers are created correctly.
2784 2736 (with-temp-buffer
2785(defun rst-toc-insert-node (stn level indent pfx) 2737 (rst-toc-insert-tree pt-stn buf rst-toc-insert-style max
2786 "Insert STN in table-of-contents. 2738 rst-toc-link-keymap nil)
2787LEVEL is the depth level of the sections in the tree currently 2739 (goto-char (point-min))
2788rendered. INDENT is the indentation string. PFX is the prefix 2740 (when (rst-forward-line-strict 1)
2789numbering, that includes the alignment necessary for all the 2741 ;; There are lines to indent.
2790children of level to align." 2742 (let ((indent-tabs-mode tabs))
2791 ;; Note: we do child numbering from the parent, so we start number the 2743 (indent-rigidly (point) (point-max) ind)))
2792 ;; children one level before we print them. 2744 (buffer-string)))
2793 (when (> level 0) 2745 (unless (zerop (length txt))
2794 (unless (> (current-column) 0) 2746 ;; Delete possible trailing text.
2795 ;; No indent yet - insert it. 2747 (delete-region (point) (line-beginning-position 2))
2796 (insert indent)) 2748 (insert txt)
2797 (let ((beg (point))) 2749 (backward-char 1))))))
2798 (unless (equal rst-toc-insert-style 'plain) 2750
2799 (insert pfx rst-toc-insert-number-separator)) 2751(defun rst-toc-insert-link (pfx stn buf keymap)
2800 (insert (rst-Stn-get-text stn)) 2752 ;; testcover: ok.
2801 ;; Add properties to the text, even though in normal text mode it 2753 "Insert text of STN in BUF as a linked section reference at point.
2802 ;; won't be doing anything for now. Not sure that I want to change 2754If KEYMAP use this as keymap property. PFX is inserted before text."
2803 ;; mode stuff. At least the highlighting gives the idea that this 2755 (let ((beg (point)))
2804 ;; is generated automatically. 2756 (insert pfx)
2805 (put-text-property beg (point) 'mouse-face 'highlight) 2757 (insert (rst-Stn-get-text stn))
2806 (put-text-property 2758 (put-text-property beg (point) 'mouse-face 'highlight)
2807 beg (point) 'rst-toc-target
2808 (set-marker (make-marker) (rst-Stn-get-title-beginning stn)))
2809 (put-text-property beg (point) 'keymap rst-toc-insert-click-keymap))
2810 (insert "\n") 2759 (insert "\n")
2811 ;; Prepare indent for children. 2760 (put-text-property
2812 (setq indent 2761 beg (point) 'rst-toc-target
2813 (cond 2762 (set-marker (make-marker) (rst-Stn-get-title-beginning stn) buf))
2814 ((eq rst-toc-insert-style 'plain) 2763 (when keymap
2815 (concat indent (make-string rst-toc-indent ? ))) 2764 (put-text-property beg (point) 'keymap keymap))))
2816 ((eq rst-toc-insert-style 'fixed) 2765
2817 (concat indent (make-string rst-toc-indent ? ))) 2766(defun rst-toc-get-link (link-buf link-pnt)
2818 ((eq rst-toc-insert-style 'aligned) 2767 ;; testcover: ok.
2819 (concat indent (make-string (+ (length pfx) 2) ? ))) 2768 "Return the link from text property at LINK-PNT in LINK-BUF."
2820 ((eq rst-toc-insert-style 'listed) 2769 (let ((mrkr (get-text-property link-pnt 'rst-toc-target link-buf)))
2821 (concat (substring indent 0 -3) 2770 (unless mrkr
2822 (concat (make-string (+ (length pfx) 2) ? ) " - ")))))) 2771 (error "No section on this line"))
2823 (when (or (eq rst-toc-insert-max-level nil) 2772 (unless (buffer-live-p (marker-buffer mrkr))
2824 (< level rst-toc-insert-max-level)) 2773 (error "Buffer for this section was killed"))
2825 (let ((count 1) 2774 mrkr))
2826 fmt) 2775
2827 ;; Add a separating dot if there is already a prefix. 2776(defconst rst-toc-link-keymap
2828 (when (> (length pfx) 0) 2777 (let ((map (make-sparse-keymap)))
2829 (string-match (rst-re "[ \t\n]*\\'") pfx) 2778 (define-key map [mouse-1] 'rst-toc-mouse-follow-link)
2830 (setq pfx (concat (replace-match "" t t pfx) "."))) 2779 map)
2831 ;; Calculate the amount of space that the prefix will require 2780 "Keymap used for links in TOC.")
2832 ;; for the numbers. 2781
2833 (when (rst-Stn-children stn) 2782(defun rst-toc-insert-tree (stn buf style depth keymap tgt-stn)
2834 (setq fmt 2783 ;; testcover: ok.
2835 (format "%%-%dd" 2784 "Insert table of contents of tree below top node STN in buffer BUF.
2836 (1+ (floor (log (length (rst-Stn-children stn)) 2785STYLE is the style to use and must be one of the symbols allowed
2837 10)))))) 2786for `rst-toc-insert-style'. DEPTH is the maximum relative depth
2838 (dolist (child (rst-Stn-children stn)) 2787from STN to insert or nil for no maximum depth. See
2839 (rst-toc-insert-node child (1+ level) indent 2788`rst-toc-insert-link' for KEYMAP. Return beginning of title line
2840 (concat pfx (format fmt count))) 2789if TGT-STN is rendered or nil if not rendered or TGT-STN is nil.
2841 (incf count))))) 2790Just return nil if STN is nil."
2791 (when stn
2792 (rst-toc-insert-children (rst-Stn-children stn) buf style depth 0 "" keymap
2793 tgt-stn)))
2794
2795(defun rst-toc-insert-children (children buf style depth indent numbering
2796 keymap tgt-stn)
2797 ;; testcover: ok.
2798 "In the current buffer at point insert CHILDREN in BUF to table of contents.
2799See `rst-toc-insert-tree' for STYLE, DEPTH and TGT-STN. See
2800`rst-toc-insert-stn' for INDENT and NUMBERING. See
2801`rst-toc-insert-link' for KEYMAP."
2802 (let ((count 1)
2803 ;; Child numbering is done from the parent.
2804 (num-fmt (format "%%%dd"
2805 (1+ (floor (log (1+ (length children)) 10)))))
2806 fnd)
2807 (when (not (equal numbering ""))
2808 ;; Add separating dot to existing numbering.
2809 (setq numbering (concat numbering ".")))
2810 (dolist (child children fnd)
2811 (setq fnd
2812 (or (rst-toc-insert-stn child buf style depth indent
2813 (concat numbering (format num-fmt count))
2814 keymap tgt-stn) fnd))
2815 (cl-incf count))))
2816
2817;; FIXME refactoring: Use `rst-Stn-buffer' instead of `buf'.
2818(defun rst-toc-insert-stn (stn buf style depth indent numbering keymap tgt-stn)
2819 ;; testcover: ok.
2820 "In the current buffer at point insert STN in BUF into table of contents.
2821See `rst-toc-insert-tree' for STYLE, DEPTH and TGT-STN. INDENT
2822is the indentation depth to use for STN. NUMBERING is the prefix
2823numbering for STN. See `rst-toc-insert-link' for KEYMAP."
2824 (when (or (not depth) (> depth 0))
2825 (cl-destructuring-bind
2826 (pfx add
2827 &aux (fnd (when (and tgt-stn
2828 (equal (rst-Stn-get-title-beginning stn)
2829 (rst-Stn-get-title-beginning tgt-stn)))
2830 (point))))
2831 (cond
2832 ((eq style 'plain)
2833 (list "" rst-toc-indent))
2834 ((eq style 'fixed)
2835 (list (concat numbering rst-toc-insert-number-separator)
2836 rst-toc-indent))
2837 ((eq style 'aligned)
2838 (list (concat numbering rst-toc-insert-number-separator)
2839 (+ (length numbering)
2840 (length rst-toc-insert-number-separator))))
2841 ((eq style 'listed)
2842 (list (format "%c " (car rst-preferred-bullets)) 2)))
2843 ;; Indent using spaces so buffer characteristics like `indent-tabs-mode'
2844 ;; do not matter.
2845 (rst-toc-insert-link (concat (make-string indent ? ) pfx) stn buf keymap)
2846 (or (rst-toc-insert-children (rst-Stn-children stn) buf style
2847 (when depth
2848 (1- depth))
2849 (+ indent add) numbering keymap tgt-stn)
2850 fnd))))
2842 2851
2843(defun rst-toc-update () 2852(defun rst-toc-update ()
2853 ;; testcover: ok.
2844 "Automatically find the contents section of a document and update. 2854 "Automatically find the contents section of a document and update.
2845Updates the inserted TOC if present. You can use this in your 2855Updates the inserted TOC if present. You can use this in your
2846file-write hook to always make it up-to-date automatically." 2856file-write hook to always make it up-to-date automatically."
2847 (interactive) 2857 (interactive)
2848 (save-excursion 2858 (save-match-data
2849 ;; Find and delete an existing comment after the first contents directive. 2859 (save-excursion
2850 ;; Delete that region. 2860 ;; Find and delete an existing comment after the first contents
2851 (goto-char (point-min)) 2861 ;; directive. Delete that region.
2852 ;; We look for the following and the following only (in other words, if your 2862 (goto-char (point-min))
2853 ;; syntax differs, this won't work.). 2863 ;; FIXME: Should accept indentation of the whole block.
2854 ;; 2864 ;; We look for the following and the following only (in other words, if
2855 ;; .. contents:: [...anything here...] 2865 ;; your syntax differs, this won't work.).
2856 ;; [:field: value]... 2866 ;;
2857 ;; .. 2867 ;; .. contents:: [...anything here...]
2858 ;; XXXXXXXX 2868 ;; [:field: value]...
2859 ;; XXXXXXXX 2869 ;; ..
2860 ;; [more lines] 2870 ;; XXXXXXXX
2861 (let ((beg (re-search-forward 2871 ;; XXXXXXXX
2862 (rst-re "^" 'exm-sta "contents" 'dcl-tag ".*\n" 2872 ;; [more lines]
2863 "\\(?:" 'hws-sta 'fld-tag ".*\n\\)*" 'exm-tag) nil t)) 2873 ;; FIXME: Works only for the first of these tocs. There should be a
2864 last-real) 2874 ;; fixed text after the comment such as "RST-MODE ELECTRIC TOC".
2865 (when beg 2875 ;; May be parameters such as `max-level' should be appended.
2866 ;; Look for the first line that starts at the first column. 2876 (let ((beg (re-search-forward
2867 (forward-line 1) 2877 (1value
2868 (while (and 2878 (rst-re "^" 'exm-sta "contents" 'dcl-tag ".*\n"
2869 (< (point) (point-max)) 2879 "\\(?:" 'hws-sta 'fld-tag ".*\n\\)*" 'exm-tag))
2870 (or (if (looking-at 2880 nil t))
2871 (rst-re 'hws-sta "\\S ")) ; indented content. 2881 fnd)
2872 (setq last-real (point))) 2882 (when
2873 (looking-at (rst-re 'lin-end)))) ; empty line. 2883 (and beg
2874 (forward-line 1)) 2884 (rst-forward-line-looking-at
2875 (if last-real 2885 1 'lin-end
2876 (progn 2886 #'(lambda (mtcd)
2877 (goto-char last-real) 2887 (unless mtcd
2878 (end-of-line) 2888 (rst-apply-indented-blocks
2879 (delete-region beg (point))) 2889 (point) (point-max) (current-indentation)
2880 (goto-char beg)) 2890 #'(lambda (count _in-first _in-sub in-super in-empty
2881 (insert "\n ") 2891 _relind)
2882 (rst-toc-insert)))) 2892 (cond
2893 ((or (> count 1) in-super))
2894 ((not in-empty)
2895 (setq fnd (line-end-position))
2896 nil)))))
2897 t)))
2898 (when fnd
2899 (delete-region beg fnd))
2900 (goto-char beg)
2901 (insert "\n ")
2902 ;; FIXME: Ignores an `max-level' given to the original
2903 ;; `rst-toc-insert'. `max-level' could be rendered to the first
2904 ;; line.
2905 (rst-toc-insert)))))
2883 ;; Note: always return nil, because this may be used as a hook. 2906 ;; Note: always return nil, because this may be used as a hook.
2884 nil) 2907 nil)
2885 2908
@@ -2891,58 +2914,26 @@ file-write hook to always make it up-to-date automatically."
2891;; ;; Disable undo for the write file hook. 2914;; ;; Disable undo for the write file hook.
2892;; (let ((buffer-undo-list t)) (rst-toc-update) )) 2915;; (let ((buffer-undo-list t)) (rst-toc-update) ))
2893 2916
2894(defalias 'rst-toc-insert-update 'rst-toc-update) ; backwards compat. 2917;; Maintain an alias for compatibility.
2918(defalias 'rst-toc-insert-update 'rst-toc-update)
2895 2919
2896(defun rst-toc-node (stn buf target) 2920(defconst rst-toc-buffer-name "*Table of Contents*"
2897 "Insert STN in the table-of-contents of buffer BUF.
2898If TARGET is given and this call renders a `rst-Stn' at the same
2899location return position of beginning of line. Otherwise return
2900nil."
2901 (let ((beg (point))
2902 fnd)
2903 (if (or (not stn) (rst-Stn-is-top stn))
2904 (progn
2905 (insert (format "Table of Contents:\n"))
2906 (put-text-property beg (point)
2907 'face (list '(background-color . "gray"))))
2908 (when (and target
2909 (equal (rst-Stn-get-title-beginning stn)
2910 (rst-Stn-get-title-beginning target)))
2911 (setq fnd beg))
2912 (insert (make-string (* rst-toc-indent (rst-Stn-level stn)) ? ))
2913 (insert (rst-Stn-get-text stn))
2914 ;; Highlight lines.
2915 (put-text-property beg (point) 'mouse-face 'highlight)
2916 (insert "\n")
2917 ;; Add link on lines.
2918 (put-text-property
2919 beg (point) 'rst-toc-target
2920 (set-marker (make-marker) (rst-Stn-get-title-beginning stn) buf)))
2921 (when stn
2922 (dolist (child (rst-Stn-children stn))
2923 (setq fnd (or (rst-toc-node child buf target) fnd))))
2924 fnd))
2925
2926(defvar rst-toc-buffer-name "*Table of Contents*"
2927 "Name of the Table of Contents buffer.") 2921 "Name of the Table of Contents buffer.")
2928 2922
2929(defvar rst-toc-return-wincfg nil 2923(defvar-local rst-toc-mode-return-wincfg nil
2930 "Window configuration to which to return when leaving the TOC.") 2924 "Window configuration to which to return when leaving the TOC.")
2931 2925
2932(defun rst-toc () 2926(defun rst-toc ()
2933 "Display a table-of-contents. 2927 ;; testcover: ok.
2934Finds all the section titles and their adornments in the 2928 "Display a table of contents for current buffer.
2935file, and displays a hierarchically-organized list of the 2929Displays all section titles found in the current buffer in a
2936titles, which is essentially a table-of-contents of the 2930hierarchical list. The resulting buffer can be navigated, and
2937document. 2931selecting a section title moves the cursor to that section."
2938
2939The Emacs buffer can be navigated, and selecting a section
2940brings the cursor in that section."
2941 (interactive) 2932 (interactive)
2942 (rst-reset-section-caches) 2933 (rst-reset-section-caches)
2943 (let* ((wincfg (list (current-window-configuration) (point-marker))) 2934 (let* ((wincfg (list (current-window-configuration) (point-marker)))
2944 (sectree (rst-all-stn)) 2935 (sectree (rst-all-stn))
2945 (target-node (rst-stn-containing-point sectree)) 2936 (target-stn (rst-stn-containing-point sectree))
2946 (target-buf (current-buffer)) 2937 (target-buf (current-buffer))
2947 (buf (get-buffer-create rst-toc-buffer-name)) 2938 (buf (get-buffer-create rst-toc-buffer-name))
2948 target-pos) 2939 target-pos)
@@ -2950,134 +2941,174 @@ brings the cursor in that section."
2950 (let ((inhibit-read-only t)) 2941 (let ((inhibit-read-only t))
2951 (rst-toc-mode) 2942 (rst-toc-mode)
2952 (delete-region (point-min) (point-max)) 2943 (delete-region (point-min) (point-max))
2953 (setq target-pos (rst-toc-node sectree target-buf target-node)))) 2944 ;; FIXME: Could use a customizable style.
2945 (setq target-pos (rst-toc-insert-tree
2946 sectree target-buf 'plain nil nil target-stn))))
2954 (display-buffer buf) 2947 (display-buffer buf)
2955 (pop-to-buffer buf) 2948 (pop-to-buffer buf)
2956 (setq-local rst-toc-return-wincfg wincfg) 2949 (setq rst-toc-mode-return-wincfg wincfg)
2957 (goto-char (or target-pos (point-min))))) 2950 (goto-char (or target-pos (point-min)))))
2958 2951
2959(defun rst-toc-mode-find-section () 2952;; Maintain an alias for compatibility.
2960 "Get the section from text property at point." 2953(defalias 'rst-goto-section 'rst-toc-follow-link)
2961 (let ((pos (get-text-property (point) 'rst-toc-target))) 2954
2962 (unless pos 2955(defun rst-toc-follow-link (link-buf link-pnt kill)
2963 (error "No section on this line")) 2956 ;; testcover: ok.
2964 (unless (buffer-live-p (marker-buffer pos)) 2957 "Follow the link to the section at LINK-PNT in LINK-BUF.
2965 (error "Buffer for this section was killed")) 2958LINK-PNT and LINK-BUF default to the point in the current buffer.
2966 pos)) 2959With prefix argument KILL a TOC buffer is destroyed. Throw an
2960error if there is no working link at the given position."
2961 (interactive "i\nd\nP")
2962 (unless link-buf
2963 (setq link-buf (current-buffer)))
2964 ;; Do not catch errors from `rst-toc-get-link' because otherwise the error is
2965 ;; suppressed and invisible in interactive use.
2966 (let ((mrkr (rst-toc-get-link link-buf link-pnt)))
2967 (condition-case nil
2968 (rst-toc-mode-return kill)
2969 ;; Catch errors when not in `toc-mode'.
2970 (error nil))
2971 (pop-to-buffer (marker-buffer mrkr))
2972 (goto-char mrkr)
2973 ;; FIXME: Should be a customizable number of lines from beginning or end of
2974 ;; window just like the argument to `recenter`. It would be ideal if
2975 ;; the adornment is always completely visible.
2976 (recenter 5)))
2977
2978;; Maintain an alias for compatibility.
2979(defalias 'rst-toc-mode-goto-section 'rst-toc-mode-follow-link-kill)
2967 2980
2968;; FIXME: Cursor before or behind the list must be handled properly; before the 2981;; FIXME: Cursor before or behind the list must be handled properly; before the
2969;; list should jump to the top and behind the list to the last normal 2982;; list should jump to the top and behind the list to the last normal
2970;; paragraph. 2983;; paragraph.
2971(defun rst-goto-section (&optional kill) 2984(defun rst-toc-mode-follow-link-kill ()
2972 "Go to the section the current line describes. 2985 ;; testcover: ok.
2973If KILL a TOC buffer is destroyed." 2986 "Follow the link to the section at point and kill the TOC buffer."
2974 (interactive) 2987 (interactive)
2975 (let ((pos (rst-toc-mode-find-section))) 2988 (rst-toc-follow-link (current-buffer) (point) t))
2976 (when kill
2977 ;; FIXME: This should rather go to `rst-toc-mode-goto-section'.
2978 (set-window-configuration (car rst-toc-return-wincfg))
2979 (kill-buffer (get-buffer rst-toc-buffer-name)))
2980 (pop-to-buffer (marker-buffer pos))
2981 (goto-char pos)
2982 ;; FIXME: make the recentering conditional on scroll.
2983 (recenter 5)))
2984 2989
2985(defun rst-toc-mode-goto-section () 2990;; Maintain an alias for compatibility.
2986 "Go to the section the current line describes and kill the TOC buffer." 2991(defalias 'rst-toc-mode-mouse-goto 'rst-toc-mouse-follow-link)
2987 (interactive)
2988 (rst-goto-section t))
2989 2992
2990(defun rst-toc-mode-mouse-goto (event) 2993(defun rst-toc-mouse-follow-link (event kill)
2994 ;; testcover: uncovered.
2991 "In `rst-toc' mode, go to the occurrence whose line you click on. 2995 "In `rst-toc' mode, go to the occurrence whose line you click on.
2992EVENT is the input event." 2996EVENT is the input event. Kill TOC buffer if KILL."
2993 (interactive "e") 2997 (interactive "e\ni")
2994 (let ((pos 2998 (rst-toc-follow-link (window-buffer (posn-window (event-end event)))
2995 (with-current-buffer (window-buffer (posn-window (event-end event))) 2999 (posn-point (event-end event)) kill))
2996 (save-excursion 3000
2997 (goto-char (posn-point (event-end event))) 3001;; Maintain an alias for compatibility.
2998 (rst-toc-mode-find-section))))) 3002(defalias 'rst-toc-mode-mouse-goto-kill 'rst-toc-mode-mouse-follow-link-kill)
2999 (pop-to-buffer (marker-buffer pos))
3000 (goto-char pos)
3001 (recenter 5)))
3002 3003
3003(defun rst-toc-mode-mouse-goto-kill (event) 3004(defun rst-toc-mode-mouse-follow-link-kill (event)
3004 "Same as `rst-toc-mode-mouse-goto', but kill TOC buffer as well. 3005 ;; testcover: uncovered.
3006 "Same as `rst-toc-mouse-follow-link', but kill TOC buffer as well.
3005EVENT is the input event." 3007EVENT is the input event."
3006 (interactive "e") 3008 (interactive "e")
3007 (call-interactively 'rst-toc-mode-mouse-goto event) 3009 (rst-toc-mouse-follow-link event t))
3008 (kill-buffer (get-buffer rst-toc-buffer-name))) 3010
3011;; Maintain an alias for compatibility.
3012(defalias 'rst-toc-quit-window 'rst-toc-mode-return)
3013
3014(defun rst-toc-mode-return (kill)
3015 ;; testcover: ok.
3016 "Leave the current TOC buffer and return to the previous environment.
3017With prefix argument KILL non-nil, kill the buffer instead of
3018burying it."
3019 (interactive "P")
3020 (unless rst-toc-mode-return-wincfg
3021 (error "Not in a `toc-mode' buffer"))
3022 (cl-destructuring-bind
3023 (wincfg pos
3024 &aux (toc-buf (current-buffer)))
3025 rst-toc-mode-return-wincfg
3026 (set-window-configuration wincfg)
3027 (goto-char pos)
3028 (if kill
3029 (kill-buffer toc-buf)
3030 (bury-buffer toc-buf))))
3009 3031
3010(defun rst-toc-quit-window () 3032(defun rst-toc-mode-return-kill ()
3011 "Leave the current TOC buffer." 3033 ;; testcover: uncovered.
3034 "Like `rst-toc-mode-return' but kill TOC buffer."
3012 (interactive) 3035 (interactive)
3013 (let ((retbuf rst-toc-return-wincfg)) 3036 (rst-toc-mode-return t))
3014 (set-window-configuration (car retbuf))
3015 (goto-char (cadr retbuf))))
3016 3037
3017(defvar rst-toc-mode-map 3038(defvar rst-toc-mode-map
3018 (let ((map (make-sparse-keymap))) 3039 (let ((map (make-sparse-keymap)))
3019 (define-key map [mouse-1] 'rst-toc-mode-mouse-goto-kill) 3040 (define-key map [mouse-1] #'rst-toc-mode-mouse-follow-link-kill)
3020 ;; FIXME: This very useful function must be on some key. 3041 (define-key map [mouse-2] #'rst-toc-mouse-follow-link)
3021 (define-key map [mouse-2] 'rst-toc-mode-mouse-goto) 3042 (define-key map "\C-m" #'rst-toc-mode-follow-link-kill)
3022 (define-key map "\C-m" 'rst-toc-mode-goto-section) 3043 (define-key map "f" #'rst-toc-mode-follow-link-kill)
3023 (define-key map "f" 'rst-toc-mode-goto-section) 3044 (define-key map "n" #'next-line)
3024 (define-key map "q" 'rst-toc-quit-window) 3045 (define-key map "p" #'previous-line)
3025 ;; FIXME: Killing should clean up like `rst-toc-quit-window' does. 3046 (define-key map "q" #'rst-toc-mode-return)
3026 (define-key map "z" 'kill-this-buffer) 3047 (define-key map "z" #'rst-toc-mode-return-kill)
3027 map) 3048 map)
3028 "Keymap for `rst-toc-mode'.") 3049 "Keymap for `rst-toc-mode'.")
3029 3050
3030(put 'rst-toc-mode 'mode-class 'special) 3051(define-derived-mode rst-toc-mode special-mode "ReST-TOC"
3031
3032;; Could inherit from the new `special-mode'.
3033(define-derived-mode rst-toc-mode nil "ReST-TOC"
3034 "Major mode for output from \\[rst-toc], the table-of-contents for the document. 3052 "Major mode for output from \\[rst-toc], the table-of-contents for the document.
3035
3036\\{rst-toc-mode-map}" 3053\\{rst-toc-mode-map}"
3037 (setq buffer-read-only t)) 3054 ;; FIXME: `revert-buffer-function` must be defined so `revert-buffer` works
3055 ;; as expected for a special mode. In particular the referred buffer
3056 ;; needs to be rescanned and the TOC must be updated accordingly.
3057 ;; FIXME: Should contain the name of the buffer this is the toc of.
3058 (setq header-line-format "Table of Contents"))
3038 3059
3039;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3060;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3040;; Section movement 3061;; Section movement
3041 3062
3042(defun rst-forward-section (&optional offset) 3063;; FIXME testcover: Use `testcover'. Mark up a function with sufficient test
3043 "Skip to the next reStructuredText section title. 3064;; coverage by a comment tagged with `testcover' after the
3044OFFSET specifies how many titles to skip. Use a negative OFFSET 3065;; `defun'. Then move this comment.
3045to move backwards in the file (default is to use 1)." 3066
3046 (interactive) 3067(defun rst-forward-section (offset)
3068 "Jump forward OFFSET section titles ending up at the start of the title line.
3069OFFSET defaults to 1 and may be negative to move backward. An
3070OFFSET of 0 does not move unless point is inside a title. Go to
3071end or beginning of buffer if no more section titles in the desired
3072direction."
3073 (interactive "p")
3047 (rst-reset-section-caches) 3074 (rst-reset-section-caches)
3048 (let* ((offset (or offset 1)) 3075 (let* ((ttls (rst-all-ttls))
3049 (ttls (rst-all-ttls)) 3076 (count (length ttls))
3050 (curpos (line-beginning-position)) 3077 (pnt (point))
3051 (cur ttls) 3078 (contained nil) ; Title contains point (or is after point otherwise).
3052 (idx 0) 3079 (found (or (cl-position-if
3053 ttl) 3080 ;; Find a title containing or after point.
3054 3081 #'(lambda (ttl)
3055 ;; Find the index of the "next" adornment with respect to the current line. 3082 (let ((cmp (rst-Ttl-contains ttl pnt)))
3056 (while (and cur (< (rst-Ttl-get-title-beginning (car cur)) curpos)) 3083 (cond
3057 (setq cur (cdr cur)) 3084 ((= cmp 0) ; Title contains point.
3058 (incf idx)) 3085 (setq contained t)
3059 ;; `cur' is the `rst-Ttl' on or following the current line. 3086 t)
3060 3087 ((> cmp 0) ; Title after point.
3061 (if (and (> offset 0) cur 3088 t))))
3062 (equal (rst-Ttl-get-title-beginning (car cur)) curpos)) 3089 ttls)
3063 (incf idx)) 3090 ;; Point after all titles.
3064 3091 count))
3065 ;; Find the final index. 3092 (target (+ found offset
3066 (setq idx (+ idx (if (> offset 0) (- offset 1) offset))) 3093 ;; If point is in plain text found title is already one
3067 (setq ttl (nth idx ttls)) 3094 ;; step forward.
3095 (if (and (not contained) (>= offset 0)) -1 0))))
3068 (goto-char (cond 3096 (goto-char (cond
3069 ((and ttl (>= idx 0)) 3097 ((< target 0)
3070 (rst-Ttl-get-title-beginning ttl)) 3098 (point-min))
3071 ((> offset 0) 3099 ((>= target count)
3072 (point-max)) 3100 (point-max))
3073 ((point-min)))))) 3101 ((and (not contained) (= offset 0))
3102 ;; Point not in title and should not move - do not move.
3103 pnt)
3104 ((rst-Ttl-get-title-beginning (nth target ttls)))))))
3074 3105
3075(defun rst-backward-section () 3106(defun rst-backward-section (offset)
3076 "Like `rst-forward-section', except move back one title." 3107 "Like `rst-forward-section', except move backward by OFFSET."
3077 (interactive) 3108 (interactive "p")
3078 (rst-forward-section -1)) 3109 (rst-forward-section (- offset)))
3079 3110
3080;; FIXME: What is `allow-extend' for? 3111;; FIXME: What is `allow-extend' for? See `mark-paragraph' for an explanation.
3081(defun rst-mark-section (&optional count allow-extend) 3112(defun rst-mark-section (&optional count allow-extend)
3082 "Select COUNT sections around point. 3113 "Select COUNT sections around point.
3083Mark following sections for positive COUNT or preceding sections 3114Mark following sections for positive COUNT or preceding sections
@@ -3110,16 +3141,18 @@ The line containing the start of the region is always considered
3110spanned. If the region ends at the beginning of a line this line 3141spanned. If the region ends at the beginning of a line this line
3111is not considered spanned, otherwise it is spanned." 3142is not considered spanned, otherwise it is spanned."
3112 (let (mincol) 3143 (let (mincol)
3113 (save-excursion 3144 (save-match-data
3114 (goto-char beg) 3145 (save-excursion
3115 (while (< (point) end) 3146 (goto-char beg)
3116 (back-to-indentation) 3147 (1value
3117 (unless (looking-at (rst-re 'lin-end)) 3148 (rst-forward-line-strict 0))
3118 (setq mincol (if mincol 3149 (while (< (point) end)
3119 (min mincol (current-column)) 3150 (unless (looking-at (rst-re 'lin-end))
3120 (current-column)))) 3151 (setq mincol (if mincol
3121 (forward-line 1))) 3152 (min mincol (current-indentation))
3122 mincol)) 3153 (current-indentation))))
3154 (rst-forward-line-strict 1 end)))
3155 mincol)))
3123 3156
3124;; FIXME: At the moment only block comments with leading empty comment line are 3157;; FIXME: At the moment only block comments with leading empty comment line are
3125;; supported. Comment lines with leading comment markup should be also 3158;; supported. Comment lines with leading comment markup should be also
@@ -3183,7 +3216,7 @@ COLUMN is the column of the tab. INNER is non-nil if this is an
3183inner tab. I.e. a tab which does come from the basic indentation 3216inner tab. I.e. a tab which does come from the basic indentation
3184and not from inner alignment points." 3217and not from inner alignment points."
3185 (save-excursion 3218 (save-excursion
3186 (forward-line 0) 3219 (rst-forward-line-strict 0)
3187 (save-match-data 3220 (save-match-data
3188 (unless (looking-at (rst-re 'lin-end)) 3221 (unless (looking-at (rst-re 'lin-end))
3189 (back-to-indentation) 3222 (back-to-indentation)
@@ -3205,7 +3238,8 @@ and not from inner alignment points."
3205 (if (zerop rst-indent-field) 3238 (if (zerop rst-indent-field)
3206 (push (list (match-end 2) 3239 (push (list (match-end 2)
3207 (if (string= (match-string 2) "") 1 0) 3240 (if (string= (match-string 2) "") 1 0)
3208 t) tabs)))) 3241 t)
3242 tabs))))
3209 ;; Directive. 3243 ;; Directive.
3210 ((looking-at (rst-re 'dir-sta-3 '(:grp "\\S ") "?")) 3244 ((looking-at (rst-re 'dir-sta-3 '(:grp "\\S ") "?"))
3211 (push (list (match-end 1) 0 t) tabs) 3245 (push (list (match-end 1) 0 t) tabs)
@@ -3223,16 +3257,18 @@ and not from inner alignment points."
3223 (push (list (point) rst-indent-comment t) tabs))) 3257 (push (list (point) rst-indent-comment t) tabs)))
3224 ;; Start of literal block. 3258 ;; Start of literal block.
3225 (when (looking-at (rst-re 'lit-sta-2)) 3259 (when (looking-at (rst-re 'lit-sta-2))
3226 (let ((tab0 (first tabs))) 3260 (cl-destructuring-bind (point offset _inner) (car tabs)
3227 (push (list (first tab0) 3261 (push (list point
3228 (+ (second tab0) 3262 (+ offset
3229 (if (match-string 1) 3263 (if (match-string 1)
3230 rst-indent-literal-minimized 3264 rst-indent-literal-minimized
3231 rst-indent-literal-normal)) 3265 rst-indent-literal-normal))
3232 t) tabs))) 3266 t)
3233 (mapcar (lambda (tab) 3267 tabs)))
3234 (goto-char (first tab)) 3268 (mapcar (cl-function
3235 (cons (+ (current-column) (second tab)) (third tab))) 3269 (lambda ((point offset inner))
3270 (goto-char point)
3271 (cons (+ (current-column) offset) inner)))
3236 tabs)))))) 3272 tabs))))))
3237 3273
3238(defun rst-compute-tabs (pt) 3274(defun rst-compute-tabs (pt)
@@ -3242,38 +3278,35 @@ Return a list of tabs sorted by likeliness to continue writing
3242like `rst-line-tabs'. Nearer lines have generally a higher 3278like `rst-line-tabs'. Nearer lines have generally a higher
3243likeliness than farther lines. Return nil if no tab is found in 3279likeliness than farther lines. Return nil if no tab is found in
3244the text above." 3280the text above."
3281 ;; FIXME: See test `indent-for-tab-command-BUGS`.
3245 (save-excursion 3282 (save-excursion
3246 (goto-char pt) 3283 (goto-char pt)
3247 (let (leftmost ; Leftmost column found so far. 3284 (let (leftmost ; Leftmost column found so far.
3248 innermost ; Leftmost column for inner tab. 3285 innermost ; Leftmost column for inner tab.
3249 tablist) 3286 tablist)
3250 (while (and (zerop (forward-line -1)) 3287 (while (and (rst-forward-line-strict -1)
3251 (or (not leftmost) 3288 (or (not leftmost)
3252 (> leftmost 0))) 3289 (> leftmost 0)))
3253 (let* ((tabs (rst-line-tabs)) 3290 (let ((tabs (rst-line-tabs)))
3254 (leftcol (if tabs (apply 'min (mapcar 'car tabs)))))
3255 (when tabs 3291 (when tabs
3256 ;; Consider only lines indented less or same if not INNERMOST. 3292 (let ((leftcol (apply #'min (mapcar #'car tabs))))
3257 (when (or (not leftmost) 3293 ;; Consider only lines indented less or same if not INNERMOST.
3258 (< leftcol leftmost) 3294 (when (or (not leftmost)
3259 (and (not innermost) (= leftcol leftmost))) 3295 (< leftcol leftmost)
3260 (dolist (tab tabs) 3296 (and (not innermost) (= leftcol leftmost)))
3261 (let ((inner (cdr tab)) 3297 (rst-destructuring-dolist ((column &rest inner) tabs)
3262 (newcol (car tab))) 3298 (when (or
3263 (when (and 3299 (and (not inner)
3264 (or 3300 (or (not leftmost)
3265 (and (not inner) 3301 (< column leftmost)))
3266 (or (not leftmost) 3302 (and inner
3267 (< newcol leftmost))) 3303 (or (not innermost)
3268 (and inner 3304 (< column innermost))))
3269 (or (not innermost) 3305 (setq tablist (cl-adjoin column tablist))))
3270 (< newcol innermost)))) 3306 (setq innermost (if (cl-some #'cdr tabs) ; Has inner.
3271 (not (memq newcol tablist))) 3307 leftcol
3272 (push newcol tablist)))) 3308 innermost))
3273 (setq innermost (if (rst-some (mapcar 'cdr tabs)) ; Has inner. 3309 (setq leftmost leftcol))))))
3274 leftcol
3275 innermost))
3276 (setq leftmost leftcol)))))
3277 (nreverse tablist)))) 3310 (nreverse tablist))))
3278 3311
3279(defun rst-indent-line (&optional dflt) 3312(defun rst-indent-line (&optional dflt)
@@ -3291,7 +3324,7 @@ relative to the content."
3291 (cur (current-indentation)) 3324 (cur (current-indentation))
3292 (clm (current-column)) 3325 (clm (current-column))
3293 (tabs (rst-compute-tabs (point))) 3326 (tabs (rst-compute-tabs (point)))
3294 (fnd (rst-position cur tabs)) 3327 (fnd (cl-position cur tabs :test #'equal))
3295 ind) 3328 ind)
3296 (if (and (not tabs) (not dflt)) 3329 (if (and (not tabs) (not dflt))
3297 'noindent 3330 'noindent
@@ -3315,7 +3348,9 @@ Shift by one tab to the right (CNT > 0) or left (CNT < 0) or
3315remove all indentation (CNT = 0). A tab is taken from the text 3348remove all indentation (CNT = 0). A tab is taken from the text
3316above. If no suitable tab is found `rst-indent-width' is used." 3349above. If no suitable tab is found `rst-indent-width' is used."
3317 (interactive "r\np") 3350 (interactive "r\np")
3318 (let ((tabs (sort (rst-compute-tabs beg) (lambda (x y) (<= x y)))) 3351 (let ((tabs (sort (rst-compute-tabs beg)
3352 #'(lambda (x y)
3353 (<= x y))))
3319 (leftmostcol (rst-find-leftmost-column beg end))) 3354 (leftmostcol (rst-find-leftmost-column beg end)))
3320 (when (or (> leftmostcol 0) (> cnt 0)) 3355 (when (or (> leftmostcol 0) (> cnt 0))
3321 ;; Apply the indent. 3356 ;; Apply the indent.
@@ -3324,17 +3359,15 @@ above. If no suitable tab is found `rst-indent-width' is used."
3324 (if (zerop cnt) 3359 (if (zerop cnt)
3325 (- leftmostcol) 3360 (- leftmostcol)
3326 ;; Find the next tab after the leftmost column. 3361 ;; Find the next tab after the leftmost column.
3327 (let* ((cmp (if (> cnt 0) '> '<)) 3362 (let* ((cmp (if (> cnt 0) #'> #'<))
3328 (tabs (if (> cnt 0) tabs (reverse tabs))) 3363 (tabs (if (> cnt 0) tabs (reverse tabs)))
3329 (len (length tabs)) 3364 (len (length tabs))
3330 (dir (rst-signum cnt)) ; Direction to take. 3365 (dir (cl-signum cnt)) ; Direction to take.
3331 (abs (abs cnt)) ; Absolute number of steps to take. 3366 (abs (abs cnt)) ; Absolute number of steps to take.
3332 ;; Get the position of the first tab beyond leftmostcol. 3367 ;; Get the position of the first tab beyond leftmostcol.
3333 (fnd (lexical-let ((cmp cmp) 3368 (fnd (cl-position-if #'(lambda (elt)
3334 (leftmostcol leftmostcol)) ;; Create closure. 3369 (funcall cmp elt leftmostcol))
3335 (rst-position-if (lambda (elt) 3370 tabs))
3336 (funcall cmp elt leftmostcol))
3337 tabs)))
3338 ;; Virtual position of tab. 3371 ;; Virtual position of tab.
3339 (pos (+ (or fnd len) (1- abs))) 3372 (pos (+ (or fnd len) (1- abs)))
3340 (tab (if (< pos len) 3373 (tab (if (< pos len)
@@ -3357,20 +3390,21 @@ above. If no suitable tab is found `rst-indent-width' is used."
3357(defun rst-adaptive-fill () 3390(defun rst-adaptive-fill ()
3358 "Return fill prefix found at point. 3391 "Return fill prefix found at point.
3359Value for `adaptive-fill-function'." 3392Value for `adaptive-fill-function'."
3360 (let ((fnd (if (looking-at adaptive-fill-regexp) 3393 (save-match-data
3361 (match-string-no-properties 0)))) 3394 (let ((fnd (if (looking-at adaptive-fill-regexp)
3362 (if (save-match-data 3395 (match-string-no-properties 0))))
3363 (not (string-match comment-start-skip fnd))) 3396 (if (save-match-data
3364 ;; An non-comment prefix is fine. 3397 (not (string-match comment-start-skip fnd)))
3365 fnd 3398 ;; An non-comment prefix is fine.
3366 ;; Matches a comment - return whitespace instead. 3399 fnd
3367 (make-string (- 3400 ;; Matches a comment - return whitespace instead.
3368 (save-excursion 3401 (make-string (-
3369 (goto-char (match-end 0)) 3402 (save-excursion
3370 (current-column)) 3403 (goto-char (match-end 0))
3371 (save-excursion 3404 (current-column))
3372 (goto-char (match-beginning 0)) 3405 (save-excursion
3373 (current-column))) ? )))) 3406 (goto-char (match-beginning 0))
3407 (current-column))) ? )))))
3374 3408
3375;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3409;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3376;; Comments 3410;; Comments
@@ -3406,10 +3440,9 @@ Region is from BEG to END. Uncomment if ARG."
3406 (if (consp arg) 3440 (if (consp arg)
3407 (rst-uncomment-region beg end arg) 3441 (rst-uncomment-region beg end arg)
3408 (goto-char beg) 3442 (goto-char beg)
3443 (rst-forward-line-strict 0)
3409 (let ((ind (current-indentation)) 3444 (let ((ind (current-indentation))
3410 bol) 3445 (bol (point)))
3411 (forward-line 0)
3412 (setq bol (point))
3413 (indent-rigidly bol end rst-indent-comment) 3446 (indent-rigidly bol end rst-indent-comment)
3414 (goto-char bol) 3447 (goto-char bol)
3415 (open-line 1) 3448 (open-line 1)
@@ -3420,14 +3453,13 @@ Region is from BEG to END. Uncomment if ARG."
3420 "Uncomment the current region. 3453 "Uncomment the current region.
3421Region is from BEG to END. _ARG is ignored" 3454Region is from BEG to END. _ARG is ignored"
3422 (save-excursion 3455 (save-excursion
3423 (let (bol eol) 3456 (goto-char beg)
3424 (goto-char beg) 3457 (rst-forward-line-strict 0)
3425 (forward-line 0) 3458 (let ((bol (point)))
3426 (setq bol (point)) 3459 (rst-forward-line-strict 1 end)
3427 (forward-line 1) 3460 (indent-rigidly (point) end (- rst-indent-comment))
3428 (setq eol (point)) 3461 (goto-char bol)
3429 (indent-rigidly eol end (- rst-indent-comment)) 3462 (rst-delete-entire-line 0))))
3430 (delete-region bol eol))))
3431 3463
3432;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3464;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3433;; Apply to indented block 3465;; Apply to indented block
@@ -3445,95 +3477,94 @@ containing or after BEG and indented to IND. After the first
3445line the indented block may contain more lines with same 3477line the indented block may contain more lines with same
3446indentation (the paragraph) followed by empty lines and lines 3478indentation (the paragraph) followed by empty lines and lines
3447more indented (the sub-blocks). A following line indented to IND 3479more indented (the sub-blocks). A following line indented to IND
3448starts the next indented block. A line with less indentation 3480starts the next paragraph. A non-empty line with less
3449than IND terminates the current indented block. Such lines and 3481indentation than IND terminates the current paragraph. FUN is
3450all following lines not indented to IND are skipped. FUN is 3482applied to each line like this
3451applied to unskipped lines like this 3483
3452 3484 (FUN COUNT IN-FIRST IN-SUB IN-SUPER IN-EMPTY RELIND)
3453 (FUN COUNT FIRSTP SUBP EMPTYP RELIND LASTRET) 3485
3454 3486COUNT is 0 before the first paragraph and increments for every
3455COUNT is 0 before the first indented block and increments for 3487paragraph found on level IND. IN-FIRST is non-nil if this is the
3456every indented block found. 3488first line of such a paragraph. IN-SUB is non-nil if this line
3457 3489is part of a sub-block while IN-SUPER is non-nil of this line is
3458FIRSTP is t when this is the first line of the paragraph. 3490part of a less indented block (super-block). IN-EMPTY is non-nil
3459 3491if this line is empty where an empty line is considered being
3460SUBP is t when this line is part of a sub-block. 3492part of the previous block. RELIND is nil for an empty line, 0
3461 3493for a line indented to IND, and the positive or negative number
3462EMPTYP is t when this line is empty. 3494of columns more or less indented otherwise. When FUN is called
3463 3495point is immediately behind indentation of that line. FUN may
3464RELIND is nil for an empty line, 0 for a line indented to IND, 3496change everything as long as a marker at END and at the beginning
3465and the number of columns more indented otherwise. 3497of the following line is handled correctly by the change. A
3466 3498non-nil return value from FUN breaks the loop and is returned.
3467LASTRET is the return value of FUN returned by the last 3499Otherwise return nil."
3468invocation for the same indented block or nil for the first 3500 (let ((endm (copy-marker end t))
3469invocation. 3501 (count 0) ; Before first indented block.
3470 3502 (nxt (when (< beg end)
3471When FUN is called point is immediately behind indentation of 3503 (copy-marker beg t)))
3472that line. FUN may change everything as long as a marker at END 3504 (broken t)
3473is handled correctly by the change. 3505 in-sub in-super stop)
3474 3506 (save-match-data
3475Return the return value of the last invocation of FUN or nil if 3507 (save-excursion
3476FUN was never called." 3508 (while (and (not stop) nxt)
3477 (let (lastret 3509 (set-marker
3478 subp 3510 (goto-char nxt) nil)
3479 skipping 3511 (setq nxt (save-excursion
3480 nextm 3512 ;; FIXME refactoring: Replace `(forward-line)
3481 (count 0) ; Before first indented block 3513 ;; (back-to-indentation)` by
3482 (endm (copy-marker end t))) 3514 ;; `(forward-to-indentation)`
3483 (save-excursion 3515 (when (and (rst-forward-line-strict 1 endm)
3484 (goto-char beg) 3516 (< (point) endm))
3485 (while (< (point) endm) 3517 (copy-marker (point) t))))
3486 (save-excursion
3487 (setq nextm (save-excursion
3488 (forward-line 1)
3489 (copy-marker (point) t)))
3490 (back-to-indentation) 3518 (back-to-indentation)
3491 (let (firstp 3519 (let ((relind (- (current-indentation) ind))
3492 emptyp 3520 (in-empty (looking-at (rst-re 'lin-end)))
3493 (relind (- (current-column) ind))) 3521 in-first)
3494 (cond 3522 (cond
3495 ((looking-at (rst-re 'lin-end)) 3523 (in-empty
3496 (setq emptyp t) 3524 (setq relind nil))
3497 (setq relind nil) 3525 ((< relind 0)
3498 ;; Breaks indented block if one is started 3526 (setq in-sub nil)
3499 (setq subp (not (zerop count)))) 3527 (setq in-super t))
3500 ((< relind 0) ; Less indented 3528 ((> relind 0)
3501 (setq skipping t)) 3529 (setq in-sub t)
3502 ((zerop relind) ; In indented block 3530 (setq in-super nil))
3503 (when (or subp skipping (zerop count)) 3531 (t ; Non-empty line in indented block.
3504 (setq firstp t) 3532 (when (or broken in-sub in-super)
3505 (incf count)) 3533 (setq in-first t)
3506 (setq subp nil) 3534 (cl-incf count))
3507 (setq skipping nil)) 3535 (setq in-sub nil)
3508 (t ; More indented 3536 (setq in-super nil)))
3509 (setq subp t))) 3537 (save-excursion
3510 (unless skipping 3538 (setq
3511 (setq lastret 3539 stop
3512 (funcall fun count firstp subp emptyp relind lastret))))) 3540 (funcall fun count in-first in-sub in-super in-empty relind)))
3513 (goto-char nextm)) 3541 (setq broken in-empty)))
3514 lastret))) 3542 (set-marker endm nil)
3543 stop))))
3515 3544
3516(defun rst-enumerate-region (beg end all) 3545(defun rst-enumerate-region (beg end all)
3517 "Add enumeration to all the leftmost paragraphs in the given region. 3546 "Add enumeration to all the leftmost paragraphs in the given region.
3518The region is specified between BEG and END. With ALL, 3547The region is specified between BEG and END. With ALL,
3519do all lines instead of just paragraphs." 3548do all lines instead of just paragraphs."
3520 (interactive "r\nP") 3549 (interactive "r\nP")
3521 (let ((enum 0)) 3550 (let ((enum 0)
3551 (indent ""))
3522 (rst-apply-indented-blocks 3552 (rst-apply-indented-blocks
3523 beg end (rst-find-leftmost-column beg end) 3553 beg end (rst-find-leftmost-column beg end)
3524 (lambda (count firstp subp emptyp relind lastret) 3554 #'(lambda (count in-first in-sub in-super in-empty _relind)
3525 (cond 3555 (cond
3526 (emptyp) 3556 (in-empty)
3527 ((zerop count)) 3557 (in-super)
3528 (subp 3558 ((zerop count))
3529 (insert lastret)) 3559 (in-sub
3530 ((or firstp all) 3560 (insert indent))
3531 (let ((ins (format "%d. " (incf enum)))) 3561 ((or in-first all)
3532 (setq lastret (make-string (length ins) ?\ )) 3562 (let ((tag (format "%d. " (cl-incf enum))))
3533 (insert ins))) 3563 (setq indent (make-string (length tag) ? ))
3534 (t 3564 (insert tag)))
3535 (insert lastret))) 3565 (t
3536 lastret)))) 3566 (insert indent)))
3567 nil))))
3537 3568
3538;; FIXME: Does not deal with deeper indentation - although 3569;; FIXME: Does not deal with deeper indentation - although
3539;; `rst-apply-indented-blocks' could. 3570;; `rst-apply-indented-blocks' could.
@@ -3544,21 +3575,22 @@ do all lines instead of just paragraphs."
3544 (interactive "r\nP") 3575 (interactive "r\nP")
3545 (unless rst-preferred-bullets 3576 (unless rst-preferred-bullets
3546 (error "No preferred bullets defined")) 3577 (error "No preferred bullets defined"))
3547 (let ((bul (format "%c " (car rst-preferred-bullets))) 3578 (let* ((bul (format "%c " (car rst-preferred-bullets)))
3548 (cont " ")) 3579 (indent (make-string (length bul) ? )))
3549 (rst-apply-indented-blocks 3580 (rst-apply-indented-blocks
3550 beg end (rst-find-leftmost-column beg end) 3581 beg end (rst-find-leftmost-column beg end)
3551 (lambda (count firstp subp emptyp relind lastret) 3582 #'(lambda (count in-first in-sub in-super in-empty _relind)
3552 (cond 3583 (cond
3553 (emptyp) 3584 (in-empty)
3554 ((zerop count)) 3585 (in-super)
3555 (subp 3586 ((zerop count))
3556 (insert cont)) 3587 (in-sub
3557 ((or firstp all) 3588 (insert indent))
3558 (insert bul)) 3589 ((or in-first all)
3559 (t 3590 (insert bul))
3560 (insert cont))) 3591 (t
3561 nil)))) 3592 (insert indent)))
3593 nil))))
3562 3594
3563;; FIXME: Does not deal with a varying number of digits appropriately. 3595;; FIXME: Does not deal with a varying number of digits appropriately.
3564;; FIXME: Does not deal with multiple levels independently. 3596;; FIXME: Does not deal with multiple levels independently.
@@ -3567,19 +3599,19 @@ do all lines instead of just paragraphs."
3567 "Convert the bulleted and enumerated items in the region to enumerated lists. 3599 "Convert the bulleted and enumerated items in the region to enumerated lists.
3568Renumber as necessary. Region is from BEG to END." 3600Renumber as necessary. Region is from BEG to END."
3569 (interactive "r") 3601 (interactive "r")
3570 (let* (;; Find items and convert the positions to markers. 3602 (let ((count 1))
3571 (items (mapcar 3603 (save-match-data
3572 (lambda (x) 3604 (save-excursion
3573 (cons (copy-marker (car x)) 3605 (dolist (marker (mapcar
3574 (cdr x))) 3606 (cl-function
3575 (rst-find-pfx-in-region beg end (rst-re 'itmany-sta-1)))) 3607 (lambda ((pnt &rest clm))
3576 (count 1)) 3608 (copy-marker pnt)))
3577 (save-excursion 3609 (rst-find-begs beg end 'itmany-beg-1)))
3578 (dolist (x items) 3610 (set-marker
3579 (goto-char (car x)) 3611 (goto-char marker) nil)
3580 (looking-at (rst-re 'itmany-beg-1)) 3612 (looking-at (rst-re 'itmany-beg-1))
3581 (replace-match (format "%d." count) nil nil nil 1) 3613 (replace-match (format "%d." count) nil nil nil 1)
3582 (incf count))))) 3614 (cl-incf count))))))
3583 3615
3584(defun rst-line-block-region (beg end &optional with-empty) 3616(defun rst-line-block-region (beg end &optional with-empty)
3585 "Add line block prefixes for a region. 3617 "Add line block prefixes for a region.
@@ -3588,10 +3620,11 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
3588 (let ((ind (rst-find-leftmost-column beg end))) 3620 (let ((ind (rst-find-leftmost-column beg end)))
3589 (rst-apply-indented-blocks 3621 (rst-apply-indented-blocks
3590 beg end ind 3622 beg end ind
3591 (lambda (count firstp subp emptyp relind lastret) 3623 #'(lambda (_count _in-first _in-sub in-super in-empty _relind)
3592 (when (or with-empty (not emptyp)) 3624 (when (and (not in-super) (or with-empty (not in-empty)))
3593 (move-to-column ind t) 3625 (move-to-column ind t)
3594 (insert "| ")))))) 3626 (insert "| "))
3627 nil))))
3595 3628
3596 3629
3597;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3630;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -4040,14 +4073,16 @@ Return nil if not or a cons with new values for BEG / END"
4040 (if (or nbeg nend) 4073 (if (or nbeg nend)
4041 (cons (or nbeg beg) (or nend end))))) 4074 (cons (or nbeg beg) (or nend end)))))
4042 4075
4076;; FIXME refactoring: Use `rst-forward-line-strict' instead.
4043(defun rst-forward-line (&optional n) 4077(defun rst-forward-line (&optional n)
4044 "Like `forward-line' but always end up in column 0 and return accordingly. 4078 "Like `forward-line' but always end up in column 0 and return accordingly.
4045Move N lines forward just as `forward-line'." 4079Move N lines forward just as `forward-line'."
4046 (let ((moved (forward-line n))) 4080 (let ((left (forward-line n)))
4047 (if (bolp) 4081 (if (bolp)
4048 moved 4082 left
4083 ;; FIXME: This may move back for positive n - is this desired?
4049 (forward-line 0) 4084 (forward-line 0)
4050 (- moved (rst-signum n))))) 4085 (- left (cl-signum n)))))
4051 4086
4052;; FIXME: If a single line is made a section header by `rst-adjust' the header 4087;; FIXME: If a single line is made a section header by `rst-adjust' the header
4053;; is not always fontified immediately. 4088;; is not always fontified immediately.
@@ -4068,77 +4103,74 @@ Return extended point or nil if not moved."
4068 ;; The second group consists of the adornment cases. 4103 ;; The second group consists of the adornment cases.
4069 (if (not (get-text-property pt 'font-lock-multiline)) 4104 (if (not (get-text-property pt 'font-lock-multiline))
4070 ;; Move only if we don't start inside a multiline construct already. 4105 ;; Move only if we don't start inside a multiline construct already.
4071 (save-excursion 4106 (save-match-data
4072 (let (;; Non-empty non-indented line, explicit markup tag or literal 4107 (save-excursion
4073 ;; block tag. 4108 (let ( ; Non-empty non-indented line, explicit markup tag or literal
4074 (stop-re (rst-re '(:alt "[^ \t\n]" 4109 ; block tag.
4075 (:seq hws-tag exm-tag) 4110 (stop-re (rst-re '(:alt "[^ \t\n]"
4076 (:seq ".*" dcl-tag lin-end))))) 4111 (:seq hws-tag exm-tag)
4077 ;; The comments below are for dir == -1 / dir == 1. 4112 (:seq ".*" dcl-tag lin-end)))))
4078 (goto-char pt) 4113 ;; The comments below are for dir == -1 / dir == 1.
4079 (forward-line 0) 4114 (goto-char pt)
4080 (setq pt (point)) 4115 (rst-forward-line-strict 0)
4081 (while (and (not (looking-at stop-re)) 4116 (setq pt (point))
4082 (zerop (rst-forward-line dir)))) ; try previous / next 4117 (while (and (not (looking-at stop-re))
4083 ; line if it exists. 4118 (zerop (rst-forward-line dir)))) ; try previous / next
4084 (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline / 4119 ; line if it exists.
4085 ; overline. 4120 (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline /
4086 (if (zerop (rst-forward-line dir)) 4121 ; overline.
4087 (if (looking-at (rst-re 'ttl-beg-1)) ; title found, i.e.
4088 ; underline / overline
4089 ; found.
4090 (if (zerop (rst-forward-line dir))
4091 (if (not
4092 (looking-at (rst-re 'ado-beg-2-1))) ; no
4093 ; overline /
4094 ; underline.
4095 (rst-forward-line (- dir)))) ; step back to title
4096 ; / adornment.
4097 (if (< dir 0) ; keep downward adornment.
4098 (rst-forward-line (- dir))))) ; step back to adornment.
4099 (if (looking-at (rst-re 'ttl-beg-1)) ; may be a title.
4100 (if (zerop (rst-forward-line dir)) 4122 (if (zerop (rst-forward-line dir))
4101 (if (not 4123 (if (looking-at (rst-re 'ttl-beg-1)) ; title found, i.e.
4102 (looking-at (rst-re 'ado-beg-2-1))) ; no overline / 4124 ; underline / overline
4103 ; underline. 4125 ; found.
4104 (rst-forward-line (- dir)))))) ; step back to line. 4126 (if (zerop (rst-forward-line dir))
4105 (if (not (= (point) pt)) 4127 (if (not
4106 (point)))))) 4128 (looking-at (rst-re 'ado-beg-2-1))) ; no
4129 ; overline
4130 ; /
4131 ; underline.
4132 (rst-forward-line (- dir)))) ; step back to
4133 ; title /
4134 ; adornment.
4135 (if (< dir 0) ; keep downward adornment.
4136 (rst-forward-line (- dir))))) ; step back to adornment.
4137 (if (looking-at (rst-re 'ttl-beg-1)) ; may be a title.
4138 (if (zerop (rst-forward-line dir))
4139 (if (not
4140 (looking-at (rst-re 'ado-beg-2-1))) ; no overline /
4141 ; underline.
4142 (rst-forward-line (- dir)))))) ; step back to line.
4143 (if (not (= (point) pt))
4144 (point)))))))
4107 4145
4108;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4146;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4109;; Indented blocks 4147;; Indented blocks
4110 4148
4111(defun rst-forward-indented-block (&optional column limit) 4149(defun rst-forward-indented-block (&optional column limit)
4150 ;; testcover: ok.
4112 "Move forward across one indented block. 4151 "Move forward across one indented block.
4113Find the next non-empty line which is not indented at least to COLUMN (defaults 4152Find the next (i.e. excluding the current line) non-empty line
4114to the column of the point). Moves point to first character of this line or the 4153which is not indented at least to COLUMN (defaults to the column
4115first empty line immediately before it and returns that position. If there is 4154of the point). Move point to first character of this line or the
4116no such line before LIMIT (defaults to the end of the buffer) returns nil and 4155first of the empty lines immediately before it and return that
4117point is not moved." 4156position. If there is no such line before LIMIT (defaults to the
4118 (interactive) 4157end of the buffer) return nil and do not move point."
4119 (let ((clm (or column (current-column))) 4158 (let (fnd candidate)
4120 (start (point)) 4159 (setq fnd (rst-apply-indented-blocks
4121 fnd beg cand) 4160 (line-beginning-position 2) ; Skip the current line
4122 (if (not limit) 4161 (or limit (point-max)) (or column (current-column))
4123 (setq limit (point-max))) 4162 #'(lambda (_count _in-first _in-sub in-super in-empty _relind)
4124 (save-match-data 4163 (cond
4125 (while (and (not fnd) (< (point) limit)) 4164 (in-empty
4126 (forward-line 1) 4165 (setq candidate (or candidate (line-beginning-position)))
4127 (when (< (point) limit) 4166 nil)
4128 (setq beg (point)) 4167 (in-super
4129 (if (looking-at (rst-re 'lin-end)) 4168 (or candidate (line-beginning-position)))
4130 (setq cand (or cand beg)) ; An empty line is a candidate. 4169 (t ; Non-empty, same or more indented line.
4131 (move-to-column clm) 4170 (setq candidate nil)
4132 ;; FIXME: No indentation [(zerop clm)] must be handled in some 4171 nil)))))
4133 ;; useful way - though it is not clear what this should mean 4172 (when fnd
4134 ;; at all. 4173 (goto-char fnd))))
4135 (if (string-match
4136 (rst-re 'linemp-tag)
4137 (buffer-substring-no-properties beg (point)))
4138 (setq cand nil) ; An indented line resets a candidate.
4139 (setq fnd (or cand beg)))))))
4140 (goto-char (or fnd start))
4141 fnd))
4142 4174
4143(defvar rst-font-lock-find-unindented-line-begin nil 4175(defvar rst-font-lock-find-unindented-line-begin nil
4144 "Beginning of the match if `rst-font-lock-find-unindented-line-end'.") 4176 "Beginning of the match if `rst-font-lock-find-unindented-line-end'.")
@@ -4156,42 +4188,43 @@ IND-PNT is non-nil but not a number take the indentation from the
4156next non-empty line if this is indented more than the current one." 4188next non-empty line if this is indented more than the current one."
4157 (setq rst-font-lock-find-unindented-line-begin ind-pnt) 4189 (setq rst-font-lock-find-unindented-line-begin ind-pnt)
4158 (setq rst-font-lock-find-unindented-line-end 4190 (setq rst-font-lock-find-unindented-line-end
4159 (save-excursion 4191 (save-match-data
4160 (when (not (numberp ind-pnt)) 4192 (save-excursion
4161 ;; Find indentation point in next line if any. 4193 (when (not (numberp ind-pnt))
4162 (setq ind-pnt 4194 ;; Find indentation point in next line if any.
4163 ;; FIXME: Should be refactored to two different functions 4195 (setq ind-pnt
4164 ;; giving their result to this function, may be 4196 ;; FIXME: Should be refactored to two different functions
4165 ;; integrated in caller. 4197 ;; giving their result to this function, may be
4166 (save-match-data 4198 ;; integrated in caller.
4167 (let ((cur-ind (current-indentation))) 4199 (save-match-data
4168 (if (eq ind-pnt 'next) 4200 (let ((cur-ind (current-indentation)))
4169 (when (and (zerop (forward-line 1)) 4201 (if (eq ind-pnt 'next)
4170 (< (point) (point-max))) 4202 (when (and (rst-forward-line-strict 1 (point-max))
4171 ;; Not at EOF. 4203 (< (point) (point-max)))
4172 (setq rst-font-lock-find-unindented-line-begin 4204 ;; Not at EOF.
4173 (point)) 4205 (setq rst-font-lock-find-unindented-line-begin
4174 (when (and (not (looking-at (rst-re 'lin-end))) 4206 (point))
4175 (> (current-indentation) cur-ind)) 4207 (when (and (not (looking-at (rst-re 'lin-end)))
4208 (> (current-indentation) cur-ind))
4176 ;; Use end of indentation if non-empty line. 4209 ;; Use end of indentation if non-empty line.
4177 (looking-at (rst-re 'hws-tag)) 4210 (looking-at (rst-re 'hws-tag))
4178 (match-end 0))) 4211 (match-end 0)))
4179 ;; Skip until non-empty line or EOF. 4212 ;; Skip until non-empty line or EOF.
4180 (while (and (zerop (forward-line 1)) 4213 (while (and (rst-forward-line-strict 1 (point-max))
4181 (< (point) (point-max)) 4214 (< (point) (point-max))
4182 (looking-at (rst-re 'lin-end)))) 4215 (looking-at (rst-re 'lin-end))))
4183 (when (< (point) (point-max)) 4216 (when (< (point) (point-max))
4184 ;; Not at EOF. 4217 ;; Not at EOF.
4185 (setq rst-font-lock-find-unindented-line-begin 4218 (setq rst-font-lock-find-unindented-line-begin
4186 (point)) 4219 (point))
4187 (when (> (current-indentation) cur-ind) 4220 (when (> (current-indentation) cur-ind)
4188 ;; Indentation bigger than line of departure. 4221 ;; Indentation bigger than line of departure.
4189 (looking-at (rst-re 'hws-tag)) 4222 (looking-at (rst-re 'hws-tag))
4190 (match-end 0)))))))) 4223 (match-end 0))))))))
4191 (when ind-pnt 4224 (when ind-pnt
4192 (goto-char ind-pnt) 4225 (goto-char ind-pnt)
4193 (or (rst-forward-indented-block nil (point-max)) 4226 (or (rst-forward-indented-block nil (point-max))
4194 (point-max)))))) 4227 (point-max)))))))
4195 4228
4196(defun rst-font-lock-find-unindented-line-match (_limit) 4229(defun rst-font-lock-find-unindented-line-match (_limit)
4197 "Set the match found earlier if match were found. 4230 "Set the match found earlier if match were found.
@@ -4359,33 +4392,31 @@ select the alternative tool-set."
4359 (interactive "P") 4392 (interactive "P")
4360 ;; Note: maybe we want to check if there is a Makefile too and not do anything 4393 ;; Note: maybe we want to check if there is a Makefile too and not do anything
4361 ;; if that is the case. I dunno. 4394 ;; if that is the case. I dunno.
4362 (let* ((toolset (cdr (assq (if use-alt 4395 (cl-destructuring-bind
4363 rst-compile-secondary-toolset 4396 (command extension options
4364 rst-compile-primary-toolset) 4397 &aux (conffile (rst-compile-find-conf))
4365 rst-compile-toolsets))) 4398 (bufname (file-name-nondirectory buffer-file-name)))
4366 (command (car toolset)) 4399 (cdr (assq (if use-alt
4367 (extension (cadr toolset)) 4400 rst-compile-secondary-toolset
4368 (options (caddr toolset)) 4401 rst-compile-primary-toolset)
4369 (conffile (rst-compile-find-conf)) 4402 rst-compile-toolsets))
4370 (bufname (file-name-nondirectory buffer-file-name))
4371 (outname (file-name-sans-extension bufname)))
4372
4373 ;; Set compile-command before invocation of compile. 4403 ;; Set compile-command before invocation of compile.
4374 (setq-local 4404 (setq-local
4375 compile-command 4405 compile-command
4376 (mapconcat 'identity 4406 (mapconcat
4377 (list command 4407 #'identity
4378 (or options "") 4408 (list command
4379 (if conffile 4409 (or options "")
4380 (concat "--config=" (shell-quote-argument conffile)) 4410 (if conffile
4381 "") 4411 (concat "--config=" (shell-quote-argument conffile))
4382 (shell-quote-argument bufname) 4412 "")
4383 (shell-quote-argument (concat outname extension))) 4413 (shell-quote-argument bufname)
4384 " ")) 4414 (shell-quote-argument (concat (file-name-sans-extension bufname)
4385 4415 extension)))
4416 " "))
4386 ;; Invoke the compile command. 4417 ;; Invoke the compile command.
4387 (if (or compilation-read-command use-alt) 4418 (if (or compilation-read-command use-alt)
4388 (call-interactively 'compile) 4419 (call-interactively #'compile)
4389 (compile compile-command)))) 4420 (compile compile-command))))
4390 4421
4391(defun rst-compile-alt-toolset () 4422(defun rst-compile-alt-toolset ()
@@ -4443,6 +4474,10 @@ buffer, if the region is not selected."
4443 4474
4444;; FIXME: Add `rst-compile-html-preview'. 4475;; FIXME: Add `rst-compile-html-preview'.
4445 4476
4477;; FIXME: Add support for `restview` (http://mg.pov.lt/restview/). May be a
4478;; more general facility for calling commands on a reST file would make
4479;; sense.
4480
4446 4481
4447;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4482;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4448;; Imenu support 4483;; Imenu support
@@ -4470,12 +4505,12 @@ buffer, if the region is not selected."
4470 ;; become visible even for long title lines. May be an additional 4505 ;; become visible even for long title lines. May be an additional
4471 ;; level number is also useful. 4506 ;; level number is also useful.
4472 (setq name (format "%s%s%s" pfx txt sfx)) 4507 (setq name (format "%s%s%s" pfx txt sfx))
4473 (cons name ;; The name of the entry. 4508 (cons name ; The name of the entry.
4474 (if children 4509 (if children
4475 (cons ;; The entry has a submenu. 4510 (cons ; The entry has a submenu.
4476 (cons name pos) ;; The entry itself. 4511 (cons name pos) ; The entry itself.
4477 (mapcar 'rst-imenu-convert-cell children)) ;; The children. 4512 (mapcar #'rst-imenu-convert-cell children)) ; The children.
4478 pos)))) ;; The position of a plain entry. 4513 pos)))) ; The position of a plain entry.
4479 4514
4480;; FIXME: Document title and subtitle need to be handled properly. They should 4515;; FIXME: Document title and subtitle need to be handled properly. They should
4481;; get an own "Document" top level entry. 4516;; get an own "Document" top level entry.
@@ -4485,7 +4520,7 @@ Return as described for `imenu--index-alist'."
4485 (rst-reset-section-caches) 4520 (rst-reset-section-caches)
4486 (let ((root (rst-all-stn))) 4521 (let ((root (rst-all-stn)))
4487 (when root 4522 (when root
4488 (mapcar 'rst-imenu-convert-cell (rst-Stn-children root))))) 4523 (mapcar #'rst-imenu-convert-cell (rst-Stn-children root)))))
4489 4524
4490 4525
4491;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4526;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -4504,7 +4539,7 @@ cand replace with char: ")
4504 (setq found (1+ found)) 4539 (setq found (1+ found))
4505 (goto-char (match-beginning 1)) 4540 (goto-char (match-beginning 1))
4506 (let ((width (current-column))) 4541 (let ((width (current-column)))
4507 (rst-delete-entire-line) 4542 (rst-delete-entire-line 0)
4508 (insert-char tochar width))) 4543 (insert-char tochar width)))
4509 (message "%d lines replaced." found)))) 4544 (message "%d lines replaced." found))))
4510 4545
@@ -4513,7 +4548,7 @@ cand replace with char: ")
4513 "Join lines in current paragraph into one line, removing end-of-lines." 4548 "Join lines in current paragraph into one line, removing end-of-lines."
4514 (interactive) 4549 (interactive)
4515 (let ((fill-column 65000)) ; Some big number. 4550 (let ((fill-column 65000)) ; Some big number.
4516 (call-interactively 'fill-paragraph))) 4551 (call-interactively #'fill-paragraph)))
4517 4552
4518;; FIXME: Unbound command - should be bound or removed. 4553;; FIXME: Unbound command - should be bound or removed.
4519(defun rst-force-fill-paragraph () 4554(defun rst-force-fill-paragraph ()
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index f476cfbba04..e148b06aa7b 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1,6 +1,6 @@
1;;; sgml-mode.el --- SGML- and HTML-editing modes -*- lexical-binding:t -*- 1;;; sgml-mode.el --- SGML- and HTML-editing modes -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1992, 1995-1996, 1998, 2001-2016 Free Software 3;; Copyright (C) 1992, 1995-1996, 1998, 2001-2017 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
5 5
6;; Author: James Clark <jjc@jclark.com> 6;; Author: James Clark <jjc@jclark.com>
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index e12a34095bb..5e967b535c4 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -1,6 +1,6 @@
1;;; table.el --- create and edit WYSIWYG text based embedded tables -*- lexical-binding: t -*- 1;;; table.el --- create and edit WYSIWYG text based embedded tables -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2000-2016 Free Software Foundation, Inc. 3;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
4 4
5;; Keywords: wp, convenience 5;; Keywords: wp, convenience
6;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com> 6;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 25d674541c5..ba6d696de90 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1,6 +1,6 @@
1;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands -*- lexical-binding:t -*- 1;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1985-1986, 1989, 1992, 1994-1999, 2001-2016 Free 3;; Copyright (C) 1985-1986, 1989, 1992, 1994-1999, 2001-2017 Free
4;; Software Foundation, Inc. 4;; Software Foundation, Inc.
5 5
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el
index 55be7fe9df5..1d2a9e52ab1 100644
--- a/lisp/textmodes/texinfmt.el
+++ b/lisp/textmodes/texinfmt.el
@@ -1,6 +1,6 @@
1;;; texinfmt.el --- format Texinfo files into Info files 1;;; texinfmt.el --- format Texinfo files into Info files
2 2
3;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2016 Free Software 3;; Copyright (C) 1985-1986, 1988, 1990-1998, 2000-2017 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
5 5
6;; Maintainer: Robert J. Chassell <bug-texinfo@gnu.org> 6;; Maintainer: Robert J. Chassell <bug-texinfo@gnu.org>
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index bc82bb6d0a4..f962dec9f09 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -1,6 +1,6 @@
1;;; texinfo.el --- major mode for editing Texinfo files 1;;; texinfo.el --- major mode for editing Texinfo files
2 2
3;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2016 Free Software 3;; Copyright (C) 1985, 1988-1993, 1996-1997, 2000-2017 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
5 5
6;; Author: Robert J. Chassell 6;; Author: Robert J. Chassell
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index b01c678ffec..aa5346d01fd 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -1,6 +1,6 @@
1;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files 1;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files
2 2
3;; Copyright (C) 1989-1992, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1989-1992, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Author: Robert J. Chassell 5;; Author: Robert J. Chassell
6;; Maintainer: bug-texinfo@gnu.org 6;; Maintainer: bug-texinfo@gnu.org
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 30873e1dfdb..7d63556dcc2 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -1,6 +1,6 @@
1;;; text-mode.el --- text mode, and its idiosyncratic commands 1;;; text-mode.el --- text mode, and its idiosyncratic commands
2 2
3;; Copyright (C) 1985, 1992, 1994, 2001-2016 Free Software Foundation, 3;; Copyright (C) 1985, 1992, 1994, 2001-2017 Free Software Foundation,
4;; Inc. 4;; Inc.
5 5
6;; Maintainer: emacs-devel@gnu.org 6;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index cd258b8c970..e4920b70c1c 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -1,6 +1,6 @@
1;;; tildify.el --- adding hard spaces into texts -*- lexical-binding: t -*- 1;;; tildify.el --- adding hard spaces into texts -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1997-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1997-2017 Free Software Foundation, Inc.
4 4
5;; Author: Milan Zamazal <pdm@zamazal.org> 5;; Author: Milan Zamazal <pdm@zamazal.org>
6;; Michal Nazarewicz <mina86@mina86.com> 6;; Michal Nazarewicz <mina86@mina86.com>
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
index 3c15c9bef7a..c6203fdf9eb 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -1,6 +1,6 @@
1;;; two-column.el --- minor mode for editing of two-column text 1;;; two-column.el --- minor mode for editing of two-column text
2 2
3;; Copyright (C) 1992-1995, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1992-1995, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Author: Daniel Pfeiffer <occitan@esperanto.org> 5;; Author: Daniel Pfeiffer <occitan@esperanto.org>
6;; Adapted-By: ESR, Daniel Pfeiffer 6;; Adapted-By: ESR, Daniel Pfeiffer
diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el
index 737475ec857..f018260b7ed 100644
--- a/lisp/textmodes/underline.el
+++ b/lisp/textmodes/underline.el
@@ -1,6 +1,6 @@
1;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs 1;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs
2 2
3;; Copyright (C) 1985, 2001-2016 Free Software Foundation, Inc. 3;; Copyright (C) 1985, 2001-2017 Free Software Foundation, Inc.
4 4
5;; Maintainer: emacs-devel@gnu.org 5;; Maintainer: emacs-devel@gnu.org
6;; Keywords: wp 6;; Keywords: wp