diff options
| author | Alan Mackenzie | 2017-02-05 16:28:53 +0000 |
|---|---|---|
| committer | Alan Mackenzie | 2017-02-05 16:28:53 +0000 |
| commit | d5514332d4a6092673ce1f78fadcae0c57f7be64 (patch) | |
| tree | 1780337154904dcfad8ecfa76614b47c082160dd /lisp/textmodes | |
| parent | cecc25c68f5a1834c356e18259aa2af402a70ce1 (diff) | |
| parent | de3336051ef74e0c3069374ced5b5fc7bb9fba15 (diff) | |
| download | emacs-d5514332d4a6092673ce1f78fadcae0c57f7be64.tar.gz emacs-d5514332d4a6092673ce1f78fadcae0c57f7be64.zip | |
Merge branch 'master' into comment-cache
Diffstat (limited to 'lisp/textmodes')
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 | 169 | ARGLIST is a Common List argument list which may include | |
| 154 | ;; Redefine some functions from `cl.el' in a proper namespace until they may be | 170 | destructuring. LIST, RESULT and BODY are as for `cl-dolist'. |
| 155 | ;; used from there. | 171 | Note that definitions in ARGLIST are visible only in the BODY and |
| 156 | 172 | neither 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 | 188 | Return t if movement is successful. Otherwise don't move point |
| 161 | ((> x 0) 1) | 189 | and return nil. If a position is given by LIMIT, movement |
| 162 | ((< x 0) -1) | 190 | happened but the following line is missing and thus its beginning |
| 163 | (t 0))) | 191 | can not be reached but the movement reached at least LIMIT |
| 164 | 192 | consider this a successful movement. LIMIT is ignored in other | |
| 165 | (defun rst-some (seq &optional pred) | 193 | cases." |
| 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)) |
| 168 | Apply PRED to each element of list SEQ until the first non-nil | 196 | (or (bolp) |
| 169 | result 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. |
| 192 | Comparison done with `equal'." | 206 | Moving forward is done by `rst-forward-line-strict'. RST-RE-ARGS |
| 193 | ;; Create a closure containing `elem' so the `lambda' always sees our | 207 | is 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 | 208 | function defaulting to `identity' which is called after the call |
| 195 | ;; of execution of the `lambda'. | 209 | to `looking-at' receiving its return value as the first argument. |
| 196 | (lexical-let ((elem elem)) | 210 | When FUN is called match data is just set by `looking-at' and |
| 197 | (rst-position-if (function (lambda (e) | 211 | point is at the beginning of the line. Return nil if moving |
| 198 | (equal elem e))) | 212 | forward failed or otherwise the return value of FUN. Preserve |
| 199 | seq))) | 213 | global 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. |
| 245 | SVN revision is the upstream (docutils) revision.") | 263 | SVN 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 | ||
| 572 | After interpretation of ARGS the results are concatenated as for | 594 | After 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. |
| 684 | Return CHAR if so or signal an error otherwise." | 706 | Return 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 | ||
| 790 | This type is immutable." | 793 | This 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. |
| 801 | Return INDENT if so or signal an error otherwise. If LAX don't | 804 | Return INDENT if so or signal an error otherwise. If LAX don't |
| 802 | signal an error and return a valid indent." | 805 | signal 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. |
| 824 | Return ADO if so or signal an error otherwise." | 826 | Return 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. |
| 906 | This type gathers information about an adorned part in the | 901 | "Representation of a reStructuredText section header as found in a buffer. |
| 907 | buffer. Thus only the basic attributes are immutable. Although | 902 | This type gathers information about an adorned part in the buffer. |
| 908 | the remaining attributes are `setf'-able the respective setters | 903 | |
| 909 | should be used." | 904 | This 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) | 1004 | ADO is the adornment or nil for a title candidate. BEG-OVR and |
| 1038 | (signal 'wrong-type-argument | 1005 | BEG-UND are the starting points of the overline or underline, |
| 1039 | (list 'integerp level))) | 1006 | respectively. They may be nil if the respective thing is missing. |
| 1040 | (unless (>= level 0) | 1007 | BEG-TXT is the beginning of the title line or the transition and |
| 1041 | (signal 'args-out-of-range | 1008 | must be given. The end of the line is used as the end point. TXT |
| 1042 | '("Level must be non-negative."))) | 1009 | is the title text or nil. If TXT is given the indentation of the |
| 1043 | level) | 1010 | line containing BEG-TXT is used as indentation. Match group 0 is |
| 1011 | derived 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'. | ||
| 1050 | Set 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. |
| 1065 | This position should always be at the start of a line." | 1039 | This 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. | ||
| 1069 | Return 0 if SELF contains POSITION, < 0 if SELF ends before | ||
| 1070 | POSITION 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. |
| 1154 | Handles missing node properly." | 1144 | Handles 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. |
| 1166 | For a missing node and no DEFAULT given return a standard title text." | 1154 | For 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. |
| 1618 | If there are existing overline and/or underline from the | 1599 | If there are existing overline and/or underline from the |
| 1619 | existing adornment, they are removed before adding the | 1600 | existing 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. |
| 1677 | ADORNMENT is the complete adornment string as found in the buffer | 1647 | ADORNMENT is the complete adornment string as found in the buffer |
| 1678 | with optional trailing whitespace. END is the point after the | 1648 | with optional trailing whitespace. END is the point after the |
| 1679 | last character of ADORNMENT. Return a `rst-Ttl' or nil if no | 1649 | last character of ADORNMENT. Return a `rst-Ttl' or nil if no |
| 1680 | syntactically valid adornment is found." | 1650 | syntactically valid adornment is found. If ACCEPT-OVER-ONLY an |
| 1651 | overline with a missing underline is accepted as valid and | ||
| 1652 | returned." | ||
| 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. |
| 1782 | If the point is on an adornment line find the respective title | 1749 | If the point is on an adornment line find the respective title |
| 1783 | line. If the point is on an empty line check previous or next | 1750 | line. 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 | |||
| 1785 | point is on a suitable title line use it. Return a `rst-Ttl' for | 1752 | point is on a suitable title line use it. Return a `rst-Ttl' for |
| 1786 | a section header or nil if no title line is found." | 1753 | a 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'. |
| 1861 | Set to t when no section adornments were found.") | 1798 | Set 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'. |
| 1868 | Set to t when no section adornments were found. | 1804 | Set to t when no section adornments were found. |
| 1869 | Value depends on `rst-all-ttls-cache'.") | 1805 | Value 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. |
| 1881 | Return a list of `rst-Ttl' with ascending line number. | 1833 | Return a list of `rst-Ttl' with ascending line number. |
| 1882 | 1834 | ||
| 1883 | Uses and sets `rst-all-ttls-cache'." | 1835 | Uses 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. |
| 1905 | HDRS reflects the order in which the headers appear in the | 1845 | HDRS reflects the order in which the headers appear in the |
| 1906 | buffer. Return a `rst-Hdr' list representing the hierarchy of | 1846 | buffer. Return a `rst-Hdr' list representing the hierarchy of |
| 1907 | headers in the buffer. Indentation is unified." | 1847 | headers 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. |
| 1932 | Each returned element may be used directly to create a section | 1866 | Each returned element may be used directly to create a section |
| 1933 | adornment on that level. If IGNORE-CURRENT a title found on the | 1867 | adornment on that level. If IGNORE-POSITION a title containing |
| 1934 | current line is not taken into account when building the | 1868 | this position is not taken into account when building the |
| 1935 | hierarchy unless it appears again elsewhere. This catches cases | 1869 | hierarchy unless it appears again elsewhere. This catches cases |
| 1936 | where the current title is edited and may not be final regarding | 1870 | where the current title is edited and may not be final regarding |
| 1937 | its level. | 1871 | its level. |
| 1938 | 1872 | ||
| 1939 | Uses and sets `rst-hdr-hierarchy-cache' unless IGNORE-CURRENT is | 1873 | Uses and sets `rst-hdr-hierarchy-cache' unless IGNORE-POSITION is |
| 1940 | given." | 1874 | given." |
| 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. |
| 1975 | Return a list of `rst-Ttl' with ascending line number." | 1908 | Return 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. | ||
| 1997 | The adornment is complete if it is a completely correct | 1926 | The adornment is complete if it is a completely correct |
| 1998 | reStructuredText adornment for the title line at point. This | 1927 | reStructuredText adornment for the title line at point. This |
| 1999 | includes indentation and correct length of adornment lines." | 1928 | includes 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. |
| 2046 | Adjust/rotate the section adornment for the section title around | 1974 | Adjust/rotate the section adornment for the section title around |
| 2047 | point or promote/demote the adornments inside the region, | 1975 | point or promote/demote the adornments inside the region, |
| @@ -2056,7 +1984,7 @@ to deal with all the possible cases gracefully and to do \"the | |||
| 2056 | right thing\" in all cases. | 1984 | right thing\" in all cases. |
| 2057 | 1985 | ||
| 2058 | See the documentations of `rst-adjust-section' and | 1986 | See the documentations of `rst-adjust-section' and |
| 2059 | `rst-promote-region' for full details. | 1987 | `rst-adjust-region' for full details. |
| 2060 | 1988 | ||
| 2061 | The method can take either (but not both) of | 1989 | The 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. | ||
| 2040 | TOGGLE-STYLE and REVERSE are from | ||
| 2041 | `rst-adjust-section'. TOGGLE-STYLE may be consumed and thus is | ||
| 2042 | returned. | ||
| 2043 | |||
| 2044 | Return a list (HDR TOGGLE-STYLE MSG...). HDR is the result or | ||
| 2045 | nil. TOGGLE-STYLE is the new TOGGLE-STYLE to use in the | ||
| 2046 | caller. MSG is a list which is non-empty in case HDR is nil | ||
| 2047 | giving 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. | ||
| 2121 | The action this function takes depends on context around the | 2108 | The action this function takes depends on context around the |
| 2122 | point, and it is meant to be invoked possibly more than once to | 2109 | point, and it is meant to be invoked possibly more than once to |
| 2123 | rotate among the various possibilities. Basically, this function | 2110 | rotate 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. |
| 2283 | With argument DEMOTE or a prefix argument, demote the section | 2215 | With argument DEMOTE or a prefix argument, demote the section |
| 2284 | titles instead. The algorithm used at the boundaries of the | 2216 | titles instead. The algorithm used at the boundaries of the |
| 2285 | hierarchy is similar to that used by `rst-adjust-section'." | 2217 | hierarchy 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. |
| 2324 | Hierarchy is displayed in a temporary buffer." | 2247 | Hierarchy 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. |
| 2345 | This is done using the preferred set of adornments. This can be | 2269 | This is done using the preferred set of adornments. This can be |
| 2346 | used, for example, when using somebody else's copy of a document, | 2270 | used, 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 | ||
| 2384 | Obviously, NUM must be greater than zero. Don't blame me, blame the | 2309 | Obviously, NUM must be greater than zero. Don't blame me, blame the |
| 2385 | Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with | 2310 | Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with |
| 2386 | apologies to Monty Python). | 2311 | apologies to Monty Python)." |
| 2387 | If 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 | |||
| 2401 | If STRING contains a letter which isn't a valid Roman numeral, | 2326 | If STRING contains a letter which isn't a valid Roman numeral, |
| 2402 | the rest of the string from that point onwards is ignored. | 2327 | the rest of the string from that point onwards is ignored. |
| 2403 | |||
| 2404 | Hence: | 2328 | Hence: |
| 2405 | MMD == 2500 | 2329 | MMD == 2500 |
| 2406 | and | 2330 | and |
| 2407 | MMDFLXXVI == 2500. | 2331 | MMDFLXXVI == 2500." |
| 2408 | If 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. |
| 2422 | This is used to find bullets and enumerated list items. PFX-RE is | 2354 | |
| 2423 | a regular expression for matching the lines after indentation | 2355 | (defun rst-insert-list-new-tag (tag) |
| 2424 | with items. Returns a list of cons cells consisting of the point | 2356 | ;; testcover: ok. |
| 2425 | and 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 | ||
| 2449 | Adding a new list might consider three situations: | 2359 | Adding 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 | |||
| 2460 | blank lines, then add the new list. | 2370 | blank lines, then add the new list. |
| 2461 | 2371 | ||
| 2462 | Other situations are just ignored and left to users themselves." | 2372 | Other 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 | ||
| 2491 | User is asked to select the item style first, for example (a), i), +. | 2400 | User is asked to select the item style first, for example (a), i), +. |
| 2492 | Use TAB for completion and choices. | 2401 | Use TAB for completion and choices. |
| 2493 | 2402 | ||
| 2494 | If user selects bullets or #, it's just added with position arranged by | 2403 | If 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 | ||
| 2497 | If user selects enumerations, a further prompt is given. User need to | 2406 | If user selects enumerations, a further prompt is given. User need to |
| 2498 | input a starting item, for example 'e' for 'A)' style. The position is | 2407 | input a starting item, for example 'e' for 'A)' style. The position is |
| 2499 | also arranged by `rst-insert-list-pos'." | 2408 | also 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. |
| 2546 | If PREFER-ROMAN roman numbering is preferred over using letters." | 2452 | "Insert a new list tag after the current line according to style. |
| 2453 | Style is defined by indentation IND, TAG and suffix TAB. If | ||
| 2454 | PREFER-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 | ||
| 2592 | The command can insert a new list or a continuing list. When it is called at a | 2505 | The 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 | |||
| 2614 | automatically. The function uses alphabetical list by default. If you want | 2527 | automatically. The function uses alphabetical list by default. If you want |
| 2615 | roman numerical list, just use a prefix to set PREFER-ROMAN." | 2528 | roman 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. | ||
| 2551 | RST-RE-BEG is a `rst-re' argument and matched at the beginning of | ||
| 2552 | a line. Return a list of (POINT . COLUMN) where POINT gives the | ||
| 2553 | point after indentation and COLUMN gives its column. The list is | ||
| 2554 | ordered 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. |
| 2624 | The 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. |
| 2625 | after you have merged multiple bulleted lists to make them use | 2586 | Use this after you have merged multiple bulleted lists to make |
| 2626 | the same/correct/consistent bullet characters. | 2587 | them use the preferred bullet characters given by |
| 2627 | 2588 | `rst-preferred-bullets' for each level. If bullets are found on | |
| 2628 | See variable `rst-preferred-bullets' for the list of bullets to | 2589 | levels beyond the `rst-preferred-bullets' list, they are not |
| 2629 | adjust. If bullets are found on levels beyond the | 2590 | modified." |
| 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. |
| 2664 | Return 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. | 2624 | Return value satisfies `rst-Stn-is-top' or is nil for no |
| 2625 | sections." | ||
| 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. |
| 2670 | REMAINING is the remaining list of `rst-Ttl' entries. | 2630 | "Process the first entry of UNPROCESSED expected to be on level EXPECTED. |
| 2671 | Return (UNPROCESSED . NODE) for the first entry of REMAINING. | 2631 | UNPROCESSED is the remaining list of (`rst-Ttl' . LEVEL) entries. |
| 2672 | UNPROCESSED is the list of still unprocessed entries. NODE is a | 2632 | Return (REMAINING . STN) for the first entry of UNPROCESSED. |
| 2673 | `rst-Stn' or nil if REMAINING is empty." | 2633 | REMAINING 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. |
| 2696 | POINT defaults to the current point. STN may be nil for no | 2660 | POINT defaults to the current point. STN may be nil for no |
| 2697 | section headers at all." | 2661 | section 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. | ||
| 2762 | By default the top level is ignored if there is only one, because | 2717 | By default the top level is ignored if there is only one, because |
| 2763 | we assume that the document will have a single title. | 2718 | we assume that the document will have a single title. A numeric |
| 2764 | 2719 | prefix argument MAX-LEVEL overrides `rst-toc-insert-max-level'. | |
| 2765 | If a numeric prefix argument PFXARG is given, insert the TOC up | 2720 | Text in the line beyond column is deleted." |
| 2766 | to the specified level. | ||
| 2767 | |||
| 2768 | The 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) |
| 2787 | LEVEL is the depth level of the sections in the tree currently | 2739 | (goto-char (point-min)) |
| 2788 | rendered. INDENT is the indentation string. PFX is the prefix | 2740 | (when (rst-forward-line-strict 1) |
| 2789 | numbering, that includes the alignment necessary for all the | 2741 | ;; There are lines to indent. |
| 2790 | children 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 | 2754 | If 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)) | 2785 | STYLE is the style to use and must be one of the symbols allowed |
| 2837 | 10)))))) | 2786 | for `rst-toc-insert-style'. DEPTH is the maximum relative depth |
| 2838 | (dolist (child (rst-Stn-children stn)) | 2787 | from 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))) | 2789 | if TGT-STN is rendered or nil if not rendered or TGT-STN is nil. |
| 2841 | (incf count))))) | 2790 | Just 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. | ||
| 2799 | See `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. | ||
| 2821 | See `rst-toc-insert-tree' for STYLE, DEPTH and TGT-STN. INDENT | ||
| 2822 | is the indentation depth to use for STN. NUMBERING is the prefix | ||
| 2823 | numbering 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. |
| 2845 | Updates the inserted TOC if present. You can use this in your | 2855 | Updates the inserted TOC if present. You can use this in your |
| 2846 | file-write hook to always make it up-to-date automatically." | 2856 | file-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. | ||
| 2898 | If TARGET is given and this call renders a `rst-Stn' at the same | ||
| 2899 | location return position of beginning of line. Otherwise return | ||
| 2900 | nil." | ||
| 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. |
| 2934 | Finds all the section titles and their adornments in the | 2928 | "Display a table of contents for current buffer. |
| 2935 | file, and displays a hierarchically-organized list of the | 2929 | Displays all section titles found in the current buffer in a |
| 2936 | titles, which is essentially a table-of-contents of the | 2930 | hierarchical list. The resulting buffer can be navigated, and |
| 2937 | document. | 2931 | selecting a section title moves the cursor to that section." |
| 2938 | |||
| 2939 | The Emacs buffer can be navigated, and selecting a section | ||
| 2940 | brings 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")) | 2958 | LINK-PNT and LINK-BUF default to the point in the current buffer. |
| 2966 | pos)) | 2959 | With prefix argument KILL a TOC buffer is destroyed. Throw an |
| 2960 | error 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. |
| 2973 | If 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. |
| 2992 | EVENT is the input event." | 2996 | EVENT 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. | ||
| 3005 | EVENT is the input event." | 3007 | EVENT 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. | ||
| 3017 | With prefix argument KILL non-nil, kill the buffer instead of | ||
| 3018 | burying 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 |
| 3044 | OFFSET specifies how many titles to skip. Use a negative OFFSET | 3065 | ;; `defun'. Then move this comment. |
| 3045 | to 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. | ||
| 3069 | OFFSET defaults to 1 and may be negative to move backward. An | ||
| 3070 | OFFSET of 0 does not move unless point is inside a title. Go to | ||
| 3071 | end or beginning of buffer if no more section titles in the desired | ||
| 3072 | direction." | ||
| 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. |
| 3083 | Mark following sections for positive COUNT or preceding sections | 3114 | Mark following sections for positive COUNT or preceding sections |
| @@ -3110,16 +3141,18 @@ The line containing the start of the region is always considered | |||
| 3110 | spanned. If the region ends at the beginning of a line this line | 3141 | spanned. If the region ends at the beginning of a line this line |
| 3111 | is not considered spanned, otherwise it is spanned." | 3142 | is 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 | |||
| 3183 | inner tab. I.e. a tab which does come from the basic indentation | 3216 | inner tab. I.e. a tab which does come from the basic indentation |
| 3184 | and not from inner alignment points." | 3217 | and 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 | |||
| 3242 | like `rst-line-tabs'. Nearer lines have generally a higher | 3278 | like `rst-line-tabs'. Nearer lines have generally a higher |
| 3243 | likeliness than farther lines. Return nil if no tab is found in | 3279 | likeliness than farther lines. Return nil if no tab is found in |
| 3244 | the text above." | 3280 | the 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 | |||
| 3315 | remove all indentation (CNT = 0). A tab is taken from the text | 3348 | remove all indentation (CNT = 0). A tab is taken from the text |
| 3316 | above. If no suitable tab is found `rst-indent-width' is used." | 3349 | above. 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. |
| 3359 | Value for `adaptive-fill-function'." | 3392 | Value 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. |
| 3421 | Region is from BEG to END. _ARG is ignored" | 3454 | Region 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 | |||
| 3445 | line the indented block may contain more lines with same | 3477 | line the indented block may contain more lines with same |
| 3446 | indentation (the paragraph) followed by empty lines and lines | 3478 | indentation (the paragraph) followed by empty lines and lines |
| 3447 | more indented (the sub-blocks). A following line indented to IND | 3479 | more indented (the sub-blocks). A following line indented to IND |
| 3448 | starts the next indented block. A line with less indentation | 3480 | starts the next paragraph. A non-empty line with less |
| 3449 | than IND terminates the current indented block. Such lines and | 3481 | indentation than IND terminates the current paragraph. FUN is |
| 3450 | all following lines not indented to IND are skipped. FUN is | 3482 | applied to each line like this |
| 3451 | applied 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 | 3486 | COUNT is 0 before the first paragraph and increments for every | |
| 3455 | COUNT is 0 before the first indented block and increments for | 3487 | paragraph found on level IND. IN-FIRST is non-nil if this is the |
| 3456 | every indented block found. | 3488 | first line of such a paragraph. IN-SUB is non-nil if this line |
| 3457 | 3489 | is part of a sub-block while IN-SUPER is non-nil of this line is | |
| 3458 | FIRSTP is t when this is the first line of the paragraph. | 3490 | part of a less indented block (super-block). IN-EMPTY is non-nil |
| 3459 | 3491 | if this line is empty where an empty line is considered being | |
| 3460 | SUBP is t when this line is part of a sub-block. | 3492 | part of the previous block. RELIND is nil for an empty line, 0 |
| 3461 | 3493 | for a line indented to IND, and the positive or negative number | |
| 3462 | EMPTYP is t when this line is empty. | 3494 | of columns more or less indented otherwise. When FUN is called |
| 3463 | 3495 | point is immediately behind indentation of that line. FUN may | |
| 3464 | RELIND is nil for an empty line, 0 for a line indented to IND, | 3496 | change everything as long as a marker at END and at the beginning |
| 3465 | and the number of columns more indented otherwise. | 3497 | of the following line is handled correctly by the change. A |
| 3466 | 3498 | non-nil return value from FUN breaks the loop and is returned. | |
| 3467 | LASTRET is the return value of FUN returned by the last | 3499 | Otherwise return nil." |
| 3468 | invocation for the same indented block or nil for the first | 3500 | (let ((endm (copy-marker end t)) |
| 3469 | invocation. | 3501 | (count 0) ; Before first indented block. |
| 3470 | 3502 | (nxt (when (< beg end) | |
| 3471 | When FUN is called point is immediately behind indentation of | 3503 | (copy-marker beg t))) |
| 3472 | that line. FUN may change everything as long as a marker at END | 3504 | (broken t) |
| 3473 | is handled correctly by the change. | 3505 | in-sub in-super stop) |
| 3474 | 3506 | (save-match-data | |
| 3475 | Return the return value of the last invocation of FUN or nil if | 3507 | (save-excursion |
| 3476 | FUN 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. |
| 3518 | The region is specified between BEG and END. With ALL, | 3547 | The region is specified between BEG and END. With ALL, |
| 3519 | do all lines instead of just paragraphs." | 3548 | do 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. |
| 3568 | Renumber as necessary. Region is from BEG to END." | 3600 | Renumber 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. |
| 4045 | Move N lines forward just as `forward-line'." | 4079 | Move 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. |
| 4113 | Find the next non-empty line which is not indented at least to COLUMN (defaults | 4152 | Find the next (i.e. excluding the current line) non-empty line |
| 4114 | to the column of the point). Moves point to first character of this line or the | 4153 | which is not indented at least to COLUMN (defaults to the column |
| 4115 | first empty line immediately before it and returns that position. If there is | 4154 | of the point). Move point to first character of this line or the |
| 4116 | no such line before LIMIT (defaults to the end of the buffer) returns nil and | 4155 | first of the empty lines immediately before it and return that |
| 4117 | point is not moved." | 4156 | position. If there is no such line before LIMIT (defaults to the |
| 4118 | (interactive) | 4157 | end 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 | |||
| 4156 | next non-empty line if this is indented more than the current one." | 4188 | next 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 |