rst.el 163 KB
Newer Older
1
;;; rst.el --- Mode for viewing and editing reStructuredText-documents  -*- lexical-binding: t -*-
Stefan Monnier's avatar
Stefan Monnier committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
Stefan Monnier's avatar
Stefan Monnier committed
4

5 6
;; Maintainer: Stefan Merten <stefan at merten-home dot de>
;; Author: Stefan Merten <stefan at merten-home dot de>,
7
;;         Martin Blais <blais@furius.ca>,
8 9
;;         David Goodger <goodger@python.org>,
;;         Wei-Wei Guo <wwguocn@gmail.com>
Stefan Monnier's avatar
Stefan Monnier committed
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

28
;; This package provides major mode rst-mode, which supports documents marked
29 30 31 32
;; up using the reStructuredText format.  Support includes font locking as well
;; as a lot of convenience functions for editing.  It does this by defining a
;; Emacs major mode: rst-mode (ReST).  This mode is derived from text-mode.
;; This package also contains:
Stefan Monnier's avatar
Stefan Monnier committed
33 34
;;
;; - Functions to automatically adjust and cycle the section underline
35
;;   adornments;
Stefan Monnier's avatar
Stefan Monnier committed
36 37 38 39
;; - A mode that displays the table of contents and allows you to jump anywhere
;;   from it;
;; - Functions to insert and automatically update a TOC in your source
;;   document;
40 41 42 43 44
;; - Function to insert list, processing item bullets and enumerations
;;   automatically;
;; - Font-lock highlighting of most reStructuredText structures;
;; - Indentation and filling according to reStructuredText syntax;
;; - Cursor movement according to reStructuredText syntax;
Stefan Monnier's avatar
Stefan Monnier committed
45 46 47 48 49 50 51 52 53 54 55
;; - Some other convenience functions.
;;
;; See the accompanying document in the docutils documentation about
;; the contents of this package and how to use it.
;;
;; For more information about reStructuredText, see
;; http://docutils.sourceforge.net/rst.html
;;
;; For full details on how to use the contents of this file, see
;; http://docutils.sourceforge.net/docs/user/emacs.html
;;
56 57 58 59
;; There are a number of convenient key bindings provided by rst-mode.  For the
;; bindings, try C-c C-h when in rst-mode.  There are also many variables that
;; can be customized, look for defcustom in this file or look for the "rst"
;; customization group contained in the "wp" group.
Stefan Monnier's avatar
Stefan Monnier committed
60 61
;;
;; If you use the table-of-contents feature, you may want to add a hook to
62
;; update the TOC automatically every time you adjust a section title::
Stefan Monnier's avatar
Stefan Monnier committed
63 64 65
;;
;;   (add-hook 'rst-adjust-hook 'rst-toc-update)
;;
Stefan Monnier's avatar
Stefan Monnier committed
66 67
;; Syntax highlighting: font-lock is enabled by default.  If you want to turn
;; off syntax highlighting to rst-mode, you can use the following::
Stefan Monnier's avatar
Stefan Monnier committed
68 69 70 71 72 73
;;
;;   (setq font-lock-global-modes '(not rst-mode ...))
;;

;;; DOWNLOAD

74 75
;; The latest release of this file lies in the docutils source code repository:
;;   http://docutils.svn.sourceforge.net/svnroot/docutils/trunk/docutils/tools/editors/emacs/rst.el
Stefan Monnier's avatar
Stefan Monnier committed
76 77 78

;;; INSTALLATION

79
;; Add the following lines to your init file:
Stefan Monnier's avatar
Stefan Monnier committed
80 81 82 83 84 85
;;
;;   (require 'rst)
;;
;; If you are using `.txt' as a standard extension for reST files as
;; http://docutils.sourceforge.net/FAQ.html#what-s-the-standard-filename-extension-for-a-restructuredtext-file
;; suggests you may use one of the `Local Variables in Files' mechanism Emacs
Stefan Monnier's avatar
Stefan Monnier committed
86
;; provides to set the major mode automatically.  For instance you may use::
Stefan Monnier's avatar
Stefan Monnier committed
87 88 89
;;
;;    .. -*- mode: rst -*-
;;
Stefan Monnier's avatar
Stefan Monnier committed
90 91
;; in the very first line of your file.  The following code is useful if you
;; want automatically enter rst-mode from any file with compatible extensions:
Stefan Monnier's avatar
Stefan Monnier committed
92 93
;;
;; (setq auto-mode-alist
94 95 96
;;       (append '(("\\.txt\\'" . rst-mode)
;;                 ("\\.rst\\'" . rst-mode)
;;                 ("\\.rest\\'" . rst-mode)) auto-mode-alist))
Stefan Monnier's avatar
Stefan Monnier committed
97 98
;;

99
;;; Code:
Stefan Monnier's avatar
Stefan Monnier committed
100

101 102
;; FIXME: Check through major mode conventions again.

103
;; FIXME: Embed complicated `defconst's in `eval-when-compile'.
104

105 106 107 108 109 110 111
;; Common Lisp stuff
(require 'cl-lib)

;; Correct wrong declaration.
(def-edebug-spec push
  (&or [form symbolp] [form gv-place]))

Paul Eggert's avatar
Paul Eggert committed
112
;; Correct wrong declaration. This still doesn't support dotted destructuring
113 114 115 116 117 118 119 120 121 122 123 124 125 126
;; though.
(def-edebug-spec cl-lambda-list
  (([&rest cl-macro-arg]
    [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
    [&optional ["&rest" arg]]
    [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
		&optional "&allow-other-keys"]]
    [&optional ["&aux" &rest
		&or (symbolp &optional def-form) symbolp]]
    )))

;; Add missing declaration.
(def-edebug-spec cl-type-spec sexp) ;; This is not exactly correct but good
				    ;; enough.
127

128 129 130
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support for `testcover'

131 132
(when (and (boundp 'testcover-1value-functions)
	   (boundp 'testcover-compose-functions))
133 134 135 136 137 138 139 140 141 142 143 144 145 146
  ;; Below `lambda' is used in a loop with varying parameters and is thus not
  ;; 1valued.
  (setq testcover-1value-functions
	(delq 'lambda testcover-1value-functions))
  (add-to-list 'testcover-compose-functions 'lambda))

(defun rst-testcover-defcustom ()
  "Remove all customized variables from `testcover-module-constants'.
This seems to be a bug in `testcover': `defcustom' variables are
considered constants.  Revert it with this function after each `defcustom'."
  (when (boundp 'testcover-module-constants)
    (setq testcover-module-constants
	  (delq nil
		(mapcar
147 148 149
		 #'(lambda (sym)
		     (if (not (plist-member (symbol-plist sym) 'standard-value))
			 sym))
150 151 152 153 154 155 156 157 158 159 160 161
		 testcover-module-constants)))))

(defun rst-testcover-add-compose (fun)
  "Add FUN to `testcover-compose-functions'."
  (when (boundp 'testcover-compose-functions)
    (add-to-list 'testcover-compose-functions fun)))

(defun rst-testcover-add-1value (fun)
  "Add FUN to `testcover-1value-functions'."
  (when (boundp 'testcover-1value-functions)
    (add-to-list 'testcover-1value-functions fun)))

162

163
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185
;; Helpers.

(cl-defmacro rst-destructuring-dolist
    ((arglist list &optional result) &rest body)
  "`cl-dolist' with destructuring of the list elements.
ARGLIST is a Common List argument list which may include
destructuring.  LIST, RESULT and BODY are as for `cl-dolist'.
Note that definitions in ARGLIST are visible only in the BODY and
neither in RESULT nor in LIST."
  ;; FIXME: It would be very useful if the definitions in ARGLIST would be
  ;;        visible in RESULT. But may be this is rather a
  ;;        `rst-destructuring-do' then.
  (declare (debug
	    (&define ([&or symbolp cl-macro-list] def-form &optional def-form)
		     cl-declarations def-body))
           (indent 1))
  (let ((var (make-symbol "--rst-destructuring-dolist-var--")))
  `(cl-dolist (,var ,list ,result)
     (cl-destructuring-bind ,arglist ,var
       ,@body))))

(defun rst-forward-line-strict (n &optional limit)
186
  ;; testcover: ok.
187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203
  "Try to move point to beginning of line I + N where I is the current line.
Return t if movement is successful.  Otherwise don't move point
and return nil.  If a position is given by LIMIT, movement
happened but the following line is missing and thus its beginning
can not be reached but the movement reached at least LIMIT
consider this a successful movement.  LIMIT is ignored in other
cases."
  (let ((start (point)))
    (if (and (zerop (forward-line n))
	     (or (bolp)
		 (and limit
		      (>= (point) limit))))
	t
      (goto-char start)
      nil)))

(defun rst-forward-line-looking-at (n rst-re-args &optional fun)
204
  ;; testcover: ok.
205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227
  "Move forward N lines and if successful check whether RST-RE-ARGS is matched.
Moving forward is done by `rst-forward-line-strict'.  RST-RE-ARGS
is a single or a list of arguments for `rst-re'.  FUN is a
function defaulting to `identity' which is called after the call
to `looking-at' receiving its return value as the first argument.
When FUN is called match data is just set by `looking-at' and
point is at the beginning of the line.  Return nil if moving
forward failed or otherwise the return value of FUN.  Preserve
global match data, point, mark and current buffer."
  (unless (listp rst-re-args)
    (setq rst-re-args (list rst-re-args)))
  (unless fun
    (setq fun #'identity))
  (save-match-data
    (save-excursion
      (when (rst-forward-line-strict n)
	(funcall fun (looking-at (apply #'rst-re rst-re-args)))))))

(rst-testcover-add-1value 'rst-delete-entire-line)
(defun rst-delete-entire-line (n)
  "Move N lines and delete the entire line."
  (delete-region (line-beginning-position (+ n 1))
                 (line-beginning-position (+ n 2))))
228

229

230 231 232 233
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Versions

(defun rst-extract-version (delim-re head-re re tail-re var &optional default)
234
  ;; testcover: ok.
235 236 237
  "Extract the version from a variable according to the given regexes.
Return the version after regex DELIM-RE and HEAD-RE matching RE
and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
238 239 240 241 242 243 244
  (if (string-match
       (concat delim-re head-re "\\(" re "\\)" tail-re delim-re)
       var)
      (match-string 1 var)
    default))

;; Use CVSHeader to really get information from CVS and not other version
245
;; control systems.
246
(defconst rst-cvs-header
247
  "$CVSHeader: sm/rst_el/rst.el,v 1.1058.2.9 2017/01/08 09:54:50 stefan Exp $")
248 249 250
(defconst rst-cvs-rev
  (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+"
		       " .*" rst-cvs-header "0.0")
251
  "The CVS revision of this file.  CVS revision is the development revision.")
252 253 254 255
(defconst rst-cvs-timestamp
  (rst-extract-version "\\$" "CVSHeader: \\S + \\S + "
		       "[0-9]+-[0-9]+-[0-9]+ [0-9]+:[0-9]+:[0-9]+" " .*"
		       rst-cvs-header "1970-01-01 00:00:00")
256
  "The CVS time stamp of this file.")
257

258
;; Use LastChanged... to really get information from SVN.
259 260
(defconst rst-svn-rev
  (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " "
261
		       "$LastChangedRevision: 8015 $")
262 263 264 265
  "The SVN revision of this file.
SVN revision is the upstream (docutils) revision.")
(defconst rst-svn-timestamp
  (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " "
266
		       "$LastChangedDate: 2017-01-08 10:54:35 +0100 (Sun, 08 Jan 2017) $")
267
  "The SVN time stamp of this file.")
268

269
;; Maintained by the release process.
270 271
(defconst rst-official-version
  (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
272
		       "%OfficialVersion: 1.5.2 %")
273 274 275
  "Official version of the package.")
(defconst rst-official-cvs-rev
  (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
276
		       "$Revision: 1.1058.2.9 $")
277 278 279 280 281 282 283 284
  "CVS revision of this file in the official version.")

(defconst rst-version
  (if (equal rst-official-cvs-rev rst-cvs-rev)
      rst-official-version
    (format "%s (development %s [%s])" rst-official-version
	    rst-cvs-rev rst-cvs-timestamp))
  "The version string.
285 286
Starts with the current official version.  For developer versions
in parentheses follows the development revision and the time stamp.")
287 288

(defconst rst-package-emacs-version-alist
289 290 291 292 293 294
  '(("1.0.0" . "24.3")
    ("1.1.0" . "24.3")
    ("1.2.0" . "24.3")
    ("1.2.1" . "24.3")
    ("1.3.0" . "24.3")
    ("1.3.1" . "24.3")
295
    ("1.4.0" . "24.3")
296
    ("1.4.1" . "24.5")
297
    ("1.4.2" . "24.5")
298
    ("1.5.0" . "26.1")
299
    ("1.5.1" . "26.2")
300 301
    ("1.5.2" . "26.2")
    ;; Whatever the Emacs version is this rst.el version ends up in.
Stefan Merten's avatar
Stefan Merten committed
302
    ))
303 304 305 306 307 308 309

(unless (assoc rst-official-version rst-package-emacs-version-alist)
  (error "Version %s not listed in `rst-package-emacs-version-alist'"
	 rst-version))

(add-to-list 'customize-package-emacs-version-alist
	     (cons 'ReST rst-package-emacs-version-alist))
Stefan Monnier's avatar
Stefan Monnier committed
310

311

312 313
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initialize customization
Stefan Monnier's avatar
Stefan Monnier committed
314

Juanma Barranquero's avatar
Juanma Barranquero committed
315
(defgroup rst nil "Support for reStructuredText documents."
316
  :group 'text
Stefan Monnier's avatar
Stefan Monnier committed
317 318 319 320 321
  :version "23.1"
  :link '(url-link "http://docutils.sourceforge.net/rst.html"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
322 323 324
;; Facilities for regular expressions used everywhere

;; The trailing numbers in the names give the number of referenceable regex
325
;; groups contained in the regex.
326 327

;; Used to be customizable but really is not customizable but fixed by the reST
328
;; syntax.
329
(defconst rst-bullets
330
  ;; Sorted so they can form a character class when concatenated.
331
  '(?- ?* ?+ ? ? ?)
332 333 334 335 336 337 338 339 340
  "List of all possible bullet characters for bulleted lists.")

(defconst rst-uri-schemes
  '("acap" "cid" "data" "dav" "fax" "file" "ftp" "gopher" "http" "https" "imap"
    "ldap" "mailto" "mid" "modem" "news" "nfs" "nntp" "pop" "prospero" "rtsp"
    "service" "sip" "tel" "telnet" "tip" "urn" "vemmi" "wais")
  "Supported URI schemes.")

(defconst rst-adornment-chars
341
  ;; Sorted so they can form a character class when concatenated.
342 343 344 345 346 347 348 349 350 351 352
  '(?\]
    ?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?+ ?, ?. ?/ ?: ?\; ?< ?= ?> ?? ?@ ?\[ ?\\
    ?^ ?_ ?` ?{ ?| ?} ?~
    ?-)
  "Characters which may be used in adornments for sections and transitions.")

(defconst rst-max-inline-length
  1000
  "Maximum length of inline markup to recognize.")

(defconst rst-re-alist-def
353 354 355 356 357 358 359 360
  ;; `*-beg' matches * at the beginning of a line.
  ;; `*-end' matches * at the end of a line.
  ;; `*-prt' matches a part of *.
  ;; `*-tag' matches *.
  ;; `*-sta' matches the start of * which may be followed by respective content.
  ;; `*-pfx' matches the delimiter left of *.
  ;; `*-sfx' matches the delimiter right of *.
  ;; `*-hlp' helper for *.
361 362 363 364 365 366
  ;;
  ;; A trailing number says how many referenceable groups are contained.
  `(

    ;; Horizontal white space (`hws')
    (hws-prt "[\t ]")
367 368
    (hws-tag hws-prt "*") ; Optional sequence of horizontal white space.
    (hws-sta hws-prt "+") ; Mandatory sequence of horizontal white space.
369 370

    ;; Lines (`lin')
371 372 373
    (lin-beg "^" hws-tag) ; Beginning of a possibly indented line.
    (lin-end hws-tag "$") ; End of a line with optional trailing white space.
    (linemp-tag "^" hws-tag "$") ; Empty line with optional white space.
374 375 376

    ;; Various tags and parts
    (ell-tag "\\.\\.\\.") ; Ellipsis
377 378 379 380 381 382 383 384
    (bul-tag ,(concat "[" rst-bullets "]")) ; A bullet.
    (ltr-tag "[a-zA-Z]") ; A letter enumerator tag.
    (num-prt "[0-9]") ; A number enumerator part.
    (num-tag num-prt "+") ; A number enumerator tag.
    (rom-prt "[IVXLCDMivxlcdm]") ; A roman enumerator part.
    (rom-tag rom-prt "+") ; A roman enumerator tag.
    (aut-tag "#") ; An automatic enumerator tag.
    (dcl-tag "::") ; Double colon.
385 386 387

    ;; Block lead in (`bli')
    (bli-sfx (:alt hws-sta "$")) ; Suffix of a block lead-in with *optional*
388
				 ; immediate content.
389 390

    ;; Various starts
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.
393 394 395 396 397 398 399

    ;; Explicit markup tag (`exm')
    (exm-tag "\\.\\.")
    (exm-sta exm-tag hws-sta)
    (exm-beg lin-beg exm-sta)

    ;; Counters in enumerations (`cnt')
400 401
    (cntany-tag (:alt ltr-tag num-tag rom-tag aut-tag)) ; An arbitrary counter.
    (cntexp-tag (:alt ltr-tag num-tag rom-tag)) ; An arbitrary explicit counter.
402 403 404 405

    ;; Enumerator (`enm')
    (enmany-tag (:alt
		 (:seq cntany-tag "\\.")
406
		 (:seq "(?" cntany-tag ")"))) ; An arbitrary enumerator.
407 408 409
    (enmexp-tag (:alt
		 (:seq cntexp-tag "\\.")
		 (:seq "(?" cntexp-tag ")"))) ; An arbitrary explicit
410
					      ; enumerator.
411 412
    (enmaut-tag (:alt
		 (:seq aut-tag "\\.")
413 414 415
		 (:seq "(?" aut-tag ")"))) ; An automatic enumerator.
    (enmany-sta enmany-tag bli-sfx) ; An arbitrary enumerator start.
    (enmexp-sta enmexp-tag bli-sfx) ; An arbitrary explicit enumerator start.
416
    (enmexp-beg lin-beg enmexp-sta) ; An arbitrary explicit enumerator start
417
				    ; at the beginning of a line.
418 419

    ;; Items may be enumerated or bulleted (`itm')
420
    (itmany-tag (:alt enmany-tag bul-tag)) ; An arbitrary item tag.
421
    (itmany-sta-1 (:grp itmany-tag) bli-sfx) ; An arbitrary item start, group
422
					     ; is the item tag.
423 424
    (itmany-beg-1 lin-beg itmany-sta-1) ; An arbitrary item start at the
				        ; beginning of a line, group is the
425
				        ; item tag.
426 427

    ;; Inline markup (`ilm')
428 429
    (ilm-pfx (:alt "^" hws-prt "[-'\"([{<‘“«’/:]"))
    (ilm-sfx (:alt "$" hws-prt "[]-'\")}>’”»/:.,;!?\\]"))
430 431

    ;; Inline markup content (`ilc')
432 433 434
    (ilcsgl-tag "\\S ") ; A single non-white character.
    (ilcast-prt (:alt "[^*\\]" "\\\\.")) ; Part of non-asterisk content.
    (ilcbkq-prt (:alt "[^`\\]" "\\\\.")) ; Part of non-backquote content.
435
    (ilcbkqdef-prt (:alt "[^`\\\n]" "\\\\.")) ; Part of non-backquote
436 437
					      ; definition.
    (ilcbar-prt (:alt "[^|\\]" "\\\\.")) ; Part of non-vertical-bar content.
438
    (ilcbardef-prt (:alt "[^|\\\n]" "\\\\.")) ; Part of non-vertical-bar
439 440 441 442 443
					      ; definition.
    (ilcast-sfx "[^\t *\\]") ; Suffix of non-asterisk content.
    (ilcbkq-sfx "[^\t `\\]") ; Suffix of non-backquote content.
    (ilcbar-sfx "[^\t |\\]") ; Suffix of non-vertical-bar content.
    (ilcrep-hlp ,(format "\\{0,%d\\}" rst-max-inline-length)) ; Repeat count.
444 445 446
    (ilcast-tag (:alt ilcsgl-tag
		      (:seq ilcsgl-tag
			    ilcast-prt ilcrep-hlp
447
			    ilcast-sfx))) ; Non-asterisk content.
448 449 450
    (ilcbkq-tag (:alt ilcsgl-tag
		      (:seq ilcsgl-tag
			    ilcbkq-prt ilcrep-hlp
451
			    ilcbkq-sfx))) ; Non-backquote content.
452 453 454
    (ilcbkqdef-tag (:alt ilcsgl-tag
			 (:seq ilcsgl-tag
			       ilcbkqdef-prt ilcrep-hlp
455
			       ilcbkq-sfx))) ; Non-backquote definition.
456 457 458
    (ilcbar-tag (:alt ilcsgl-tag
		      (:seq ilcsgl-tag
			    ilcbar-prt ilcrep-hlp
459
			    ilcbar-sfx))) ; Non-vertical-bar content.
460 461 462
    (ilcbardef-tag (:alt ilcsgl-tag
			 (:seq ilcsgl-tag
			       ilcbardef-prt ilcrep-hlp
463
			       ilcbar-sfx))) ; Non-vertical-bar definition.
464 465

    ;; Fields (`fld')
466 467 468
    (fldnam-prt (:alt "[^:\n]" "\\\\:")) ; Part of a field name.
    (fldnam-tag fldnam-prt "+") ; A field name.
    (fld-tag ":" fldnam-tag ":") ; A field marker.
469 470

    ;; Options (`opt')
471 472 473 474 475
    (optsta-tag (:alt "[-+/]" "--")) ; Start of an option.
    (optnam-tag "\\sw" (:alt "-" "\\sw") "*") ; Name of an option.
    (optarg-tag (:shy "[ =]\\S +")) ; Option argument.
    (optsep-tag (:shy "," hws-prt)) ; Separator between options.
    (opt-tag (:shy optsta-tag optnam-tag optarg-tag "?")) ; A complete option.
476 477

    ;; Footnotes and citations (`fnc')
478
    (fncnam-prt "[^]\n]") ; Part of a footnote or citation name.
479 480
    (fncnam-tag fncnam-prt "+") ; A footnote or citation name.
    (fnc-tag "\\[" fncnam-tag "]") ; A complete footnote or citation tag.
481 482
    (fncdef-tag-2 (:grp exm-sta)
		  (:grp fnc-tag)) ; A complete footnote or citation definition
483
				  ; tag.  First group is the explicit markup
484
				  ; start, second group is the footnote /
485
				  ; citation tag.
486
    (fnc-sta-2 fncdef-tag-2 bli-sfx) ; Start of a footnote or citation
487
				     ; definition.  First group is the explicit
488
				     ; markup start, second group is the
489
				     ; footnote / citation tag.
490 491

    ;; Substitutions (`sub')
492
    (sub-tag "|" ilcbar-tag "|") ; A complete substitution tag.
493
    (subdef-tag "|" ilcbardef-tag "|") ; A complete substitution definition
494
				       ; tag.
495 496

    ;; Symbol (`sym')
497 498
    (sym-prt "[-+.:_]") ; Non-word part of a symbol.
    (sym-tag (:shy "\\sw+" (:shy sym-prt "\\sw+") "*"))
499 500 501 502 503 504 505 506

    ;; URIs (`uri')
    (uri-tag (:alt ,@rst-uri-schemes))

    ;; Adornment (`ado')
    (ado-prt "[" ,(concat rst-adornment-chars) "]")
    (adorep3-hlp "\\{3,\\}") ; There must be at least 3 characters because
			     ; otherwise explicit markup start would be
507
			     ; recognized.
508
    (adorep2-hlp "\\{2,\\}") ; As `adorep3-hlp' but when the first of three
509
			     ; characters is matched differently.
510 511 512
    (ado-tag-1-1 (:grp ado-prt)
		 "\\1" adorep2-hlp) ; A complete adornment, group is the first
				    ; adornment character and MUST be the FIRST
513
				    ; group in the whole expression.
514 515 516
    (ado-tag-1-2 (:grp ado-prt)
		 "\\2" adorep2-hlp) ; A complete adornment, group is the first
				    ; adornment character and MUST be the
517
				    ; SECOND group in the whole expression.
518 519 520 521
    (ado-beg-2-1 "^" (:grp ado-tag-1-2)
		 lin-end) ; A complete adornment line; first group is the whole
			  ; adornment and MUST be the FIRST group in the whole
			  ; expression; second group is the first adornment
522
			  ; character.
523 524

    ;; Titles (`ttl')
525 526 527 528
    (ttl-tag "\\S *\\w.*\\S ") ; A title text.
    (ttl-beg-1 lin-beg (:grp ttl-tag)) ; A title text at the beginning of a
				       ; line.  First group is the complete,
				       ; trimmed title text.
529 530 531 532 533

    ;; Directives and substitution definitions (`dir')
    (dir-tag-3 (:grp exm-sta)
	       (:grp (:shy subdef-tag hws-sta) "?")
	       (:grp sym-tag dcl-tag)) ; A directive or substitution definition
534
				       ; tag.  First group is explicit markup
535 536 537
				       ; start, second group is a possibly
				       ; empty substitution tag, third group is
				       ; the directive tag including the double
538
				       ; colon.
539
    (dir-sta-3 dir-tag-3 bli-sfx) ; Start of a directive or substitution
540
				  ; definition.  Groups are as in dir-tag-3.
541 542 543

    ;; Literal block (`lit')
    (lit-sta-2 (:grp (:alt "[^.\n]" "\\.[^.\n]") ".*") "?"
544
	       (:grp dcl-tag) "$") ; Start of a literal block.  First group is
545 546
				   ; any text before the double colon tag which
				   ; may not exist, second group is the double
547
				   ; colon tag.
548 549

    ;; Comments (`cmt')
550
    (cmt-sta-1 (:grp exm-sta) "[^[|_\n]"
551 552
	       (:alt "[^:\n]" (:seq ":" (:alt "[^:\n]" "$")))
	       "*$") ; Start of a comment block; first group is explicit markup
553
		     ; start.
554 555 556 557

    ;; Paragraphs (`par')
    (par-tag- (:alt itmany-tag fld-tag opt-tag fncdef-tag-2 dir-tag-3 exm-tag)
	      ) ; Tag at the beginning of a paragraph; there may be groups in
558
		; certain cases.
559 560 561 562 563
    )
  "Definition alist of relevant regexes.
Each entry consists of the symbol naming the regex and an
argument list for `rst-re'.")

564 565
(defvar rst-re-alist) ; Forward declare to use it in `rst-re'.

566
;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel.
567
(rst-testcover-add-compose 'rst-re)
568
(defun rst-re (&rest args)
569
  ;; testcover: ok.
570 571 572 573 574 575 576 577 578
  "Interpret ARGS as regular expressions and return a regex string.
Each element of ARGS may be one of the following:

A string which is inserted unchanged.

A character which is resolved to a quoted regex.

A symbol which is resolved to a string using `rst-re-alist-def'.

579 580
A list with a keyword in the car.  Each element of the cdr of such
a list is recursively interpreted as ARGS.  The results of this
581 582 583 584 585 586 587 588 589 590 591
interpretation are concatenated according to the keyword.

For the keyword `:seq' the results are simply concatenated.

For the keyword `:shy' the results are concatenated and
surrounded by a shy-group (\"\\(?:...\\)\").

For the keyword `:alt' the results form an alternative (\"\\|\")
which is shy-grouped (\"\\(?:...\\)\").

For the keyword `:grp' the results are concatenated and form a
592
referenceable group (\"\\(...\\)\").
593 594

After interpretation of ARGS the results are concatenated as for
595
`:seq'."
596
  (apply #'concat
597
	 (mapcar
598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623
	  #'(lambda (re)
	      (cond
	       ((stringp re)
		re)
	       ((symbolp re)
		(cadr (assoc re rst-re-alist)))
	       ((characterp re)
		(regexp-quote (char-to-string re)))
	       ((listp re)
		(let ((nested
		       (mapcar (lambda (elt)
				 (rst-re elt))
			       (cdr re))))
		  (cond
		   ((eq (car re) :seq)
		    (mapconcat #'identity nested ""))
		   ((eq (car re) :shy)
		    (concat "\\(?:" (mapconcat #'identity nested "") "\\)"))
		   ((eq (car re) :grp)
		    (concat "\\(" (mapconcat #'identity nested "") "\\)"))
		   ((eq (car re) :alt)
		    (concat "\\(?:" (mapconcat #'identity nested "\\|") "\\)"))
		   (t
		    (error "Unknown list car: %s" (car re))))))
	       (t
		(error "Unknown object type for building regex: %s" re))))
624 625
	  args)))

626
;; FIXME: Remove circular dependency between `rst-re' and `rst-re-alist'.
627 628 629 630 631 632 633 634
(with-no-warnings ; Silence byte-compiler about this construction.
  (defconst rst-re-alist
    ;; Shadow global value we are just defining so we can construct it step by
    ;; step.
    (let (rst-re-alist)
      (dolist (re rst-re-alist-def rst-re-alist)
	(setq rst-re-alist
	      (nconc rst-re-alist
635
		     (list (list (car re) (apply #'rst-re (cdr re))))))))
636
    "Alist mapping symbols from `rst-re-alist-def' to regex strings."))
637

638 639 640 641 642 643 644 645 646 647

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Concepts

;; Each of the following classes represents an own concept. The suffix of the
;; class name is used in the code to represent entities of the respective
;; class.
;;
;; In addition a reStructuredText section header in the buffer is called
;; "section".
Paul Eggert's avatar
Paul Eggert committed
648
;;
649 650 651 652 653 654
;; For lists a "s" is added to the name of the concepts.


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Class rst-Ado

655
(cl-defstruct
656
  (rst-Ado
657
   (:constructor nil) ; Prevent creating unchecked values.
658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706
   ;; Construct a transition.
   (:constructor
    rst-Ado-new-transition
    (&aux
     (char nil)
     (-style 'transition)))
   ;; Construct a simple section header.
   (:constructor
    rst-Ado-new-simple
    (char-arg
     &aux
     (char (rst-Ado--validate-char char-arg))
     (-style 'simple)))
   ;; Construct a over-and-under section header.
   (:constructor
    rst-Ado-new-over-and-under
    (char-arg
     &aux
     (char (rst-Ado--validate-char char-arg))
     (-style 'over-and-under)))
   ;; Construct from adornment with inverted style.
   (:constructor
    rst-Ado-new-invert
    (ado-arg
     &aux
     (char (rst-Ado-char ado-arg))
     (-style (let ((sty (rst-Ado--style ado-arg)))
	      (cond
	       ((eq sty 'simple)
		'over-and-under)
	       ((eq sty 'over-and-under)
		'simple)
	       (sty)))))))
  "Representation of a reStructuredText adornment.
Adornments are either section markers where they markup the
section header or transitions.

This type is immutable."
  ;; The character used for the adornment.
  (char nil :read-only t)
  ;; The style of the adornment. This is a private attribute.
  (-style nil :read-only t))

;; Private class methods

(defun rst-Ado--validate-char (char)
  ;; testcover: ok.
  "Validate CHAR to be a valid adornment character.
Return CHAR if so or signal an error otherwise."
707 708 709 710 711 712
  (cl-check-type char character)
  (cl-check-type char (satisfies
		       (lambda (c)
			 (memq c rst-adornment-chars)))
		 "Character must be a valid adornment character")
  char)
713 714 715 716 717 718

;; Public methods

(defun rst-Ado-is-transition (self)
  ;; testcover: ok.
  "Return non-nil if SELF is a transition adornment."
719
  (cl-check-type self rst-Ado)
720 721 722 723 724
  (eq (rst-Ado--style self) 'transition))

(defun rst-Ado-is-section (self)
  ;; testcover: ok.
  "Return non-nil if SELF is a section adornment."
725
  (cl-check-type self rst-Ado)
726 727 728 729 730
  (not (rst-Ado-is-transition self)))

(defun rst-Ado-is-simple (self)
  ;; testcover: ok.
  "Return non-nil if SELF is a simple section adornment."
731
  (cl-check-type self rst-Ado)
732 733 734 735 736
  (eq (rst-Ado--style self) 'simple))

(defun rst-Ado-is-over-and-under (self)
  ;; testcover: ok.
  "Return non-nil if SELF is a over-and-under section adornment."
737
  (cl-check-type self rst-Ado)
738 739 740 741 742
  (eq (rst-Ado--style self) 'over-and-under))

(defun rst-Ado-equal (self other)
  ;; testcover: ok.
  "Return non-nil when SELF and OTHER are equal."
743 744
  (cl-check-type self rst-Ado)
  (cl-check-type other rst-Ado)
745 746 747 748 749 750 751 752
  (cond
   ((not (eq (rst-Ado--style self) (rst-Ado--style other)))
    nil)
   ((rst-Ado-is-transition self))
   ((equal (rst-Ado-char self) (rst-Ado-char other)))))

(defun rst-Ado-position (self ados)
  ;; testcover: ok.
753 754 755 756 757
  "Return position of SELF in ADOS or nil."
  (cl-check-type self rst-Ado)
  (cl-position-if #'(lambda (e)
		      (rst-Ado-equal self e))
		  ados))
758 759 760 761 762


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Class rst-Hdr

763
(cl-defstruct
764
  (rst-Hdr
765
   (:constructor nil) ; Prevent creating unchecked values.
766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789
   ;; Construct while all parameters must be valid.
   (:constructor
    rst-Hdr-new
    (ado-arg
     indent-arg
     &aux
     (ado (rst-Hdr--validate-ado ado-arg))
     (indent (rst-Hdr--validate-indent indent-arg ado nil))))
   ;; Construct while all parameters but `indent' must be valid.
   (:constructor
    rst-Hdr-new-lax
    (ado-arg
     indent-arg
     &aux
     (ado (rst-Hdr--validate-ado ado-arg))
     (indent (rst-Hdr--validate-indent indent-arg ado t))))
   ;; Construct a header with same characteristics but opposite style as `ado'.
   (:constructor
    rst-Hdr-new-invert
    (ado-arg
     indent-arg
     &aux
     (ado (rst-Hdr--validate-ado (rst-Ado-new-invert ado-arg)))
     (indent (rst-Hdr--validate-indent indent-arg ado t))))
790
   (:copier nil)) ; Not really needed for an immutable type.
791 792 793 794 795 796 797 798 799 800 801 802 803 804 805
  "Representation of reStructuredText section header characteristics.

This type is immutable."
  ;; The adornment of the header.
  (ado nil :read-only t)
  ;; The indentation of a title text or nil if not given.
  (indent nil :read-only t))

;; Private class methods

(defun rst-Hdr--validate-indent (indent ado lax)
  ;; testcover: ok.
  "Validate INDENT to be a valid indentation for ADO.
Return INDENT if so or signal an error otherwise.  If LAX don't
signal an error and return a valid indent."
806
  (cl-check-type indent integer)
807 808 809 810 811 812 813 814 815 816 817 818 819
  (cond
   ((zerop indent)
    indent)
   ((rst-Ado-is-simple ado)
    (if lax
	0
      (signal 'args-out-of-range
	      '("Indentation must be 0 for style simple"))))
   ((< indent 0)
    (if lax
	0
      (signal 'args-out-of-range
	      '("Indentation must not be negative"))))
820 821
   ;; Implicitly over-and-under.
   (indent)))
822 823 824 825 826

(defun rst-Hdr--validate-ado (ado)
  ;; testcover: ok.
  "Validate ADO to be a valid adornment.
Return ADO if so or signal an error otherwise."
827
  (cl-check-type ado rst-Ado)
828 829 830 831
  (cond
   ((rst-Ado-is-transition ado)
    (signal 'args-out-of-range
	    '("Adornment for header must not be transition.")))
832
   (ado)))
833 834 835

;; Public class methods

836 837
(defvar rst-preferred-adornments) ; Forward declaration.

838 839 840
(defun rst-Hdr-preferred-adornments ()
  ;; testcover: ok.
  "Return preferred adornments as list of `rst-Hdr'."
841 842 843 844 845 846 847
  (mapcar (cl-function
	   (lambda ((character style indent))
	     (rst-Hdr-new-lax
	      (if (eq style 'over-and-under)
		  (rst-Ado-new-over-and-under character)
		(rst-Ado-new-simple character))
	      indent)))
848 849 850 851 852 853 854
	  rst-preferred-adornments))

;; Public methods

(defun rst-Hdr-member-ado (self hdrs)
  ;; testcover: ok.
  "Return sublist of HDRS whose car's adornment equals that of SELF or nil."
855 856 857 858 859
  (cl-check-type self rst-Hdr)
  (let ((ado (rst-Hdr-ado self)))
    (cl-member-if #'(lambda (hdr)
		      (rst-Ado-equal ado (rst-Hdr-ado hdr)))
		  hdrs)))
860

Paul Eggert's avatar
Paul Eggert committed
861
(defun rst-Hdr-ado-map (selves)
862
  ;; testcover: ok.
Paul Eggert's avatar
Paul Eggert committed
863
  "Return `rst-Ado' list extracted from elements of SELVES."
864
  (mapcar #'rst-Hdr-ado selves))
865 866 867 868

(defun rst-Hdr-get-char (self)
  ;; testcover: ok.
  "Return character of the adornment of SELF."
869
  (cl-check-type self rst-Hdr)
870 871 872 873 874
  (rst-Ado-char (rst-Hdr-ado self)))

(defun rst-Hdr-is-over-and-under (self)
  ;; testcover: ok.
  "Return non-nil if SELF is a over-and-under section header."
875
  (cl-check-type self rst-Hdr)
876 877 878 879 880 881
  (rst-Ado-is-over-and-under (rst-Hdr-ado self)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Class rst-Ttl

882
(cl-defstruct
883
  (rst-Ttl
884
   (:constructor nil) ; Prevent creating unchecked values.
885
   ;; Construct with valid parameters for all attributes.
886 887
   (:constructor ; Private constructor
    rst-Ttl--new
888 889 890 891 892 893 894 895 896
    (ado-arg
     match-arg
     indent-arg
     text-arg
     &aux
     (ado (rst-Ttl--validate-ado ado-arg))
     (match (rst-Ttl--validate-match match-arg ado))
     (indent (rst-Ttl--validate-indent indent-arg ado))
     (text (rst-Ttl--validate-text text-arg ado))
897 898 899 900 901 902 903 904
     (hdr (condition-case nil
	      (rst-Hdr-new ado indent)
	    (error nil)))))
   (:copier nil)) ; Not really needed for an immutable type.
  "Representation of a reStructuredText section header as found in a buffer.
This type gathers information about an adorned part in the buffer.

This type is immutable."
905 906
  ;; The adornment characteristics or nil for a title candidate.
  (ado nil :read-only t)
907 908 909 910 911
  ;; The match-data for `ado' in a form similarly returned by `match-data' (but
  ;; not necessarily with markers in buffers). Match group 0 matches the whole
  ;; construct.  Match group 1 matches the overline adornment if present.
  ;; Match group 2 matches the section title text or the transition.  Match
  ;; group 3 matches the underline adornment.
912 913 914 915 916 917
  (match nil :read-only t)
  ;; An indentation found for the title line or nil for a transition.
  (indent nil :read-only t)
  ;; The text of the title or nil for a transition.
  (text nil :read-only t)
  ;; The header characteristics if it is a valid section header.
918 919 920 921 922 923 924 925
  (hdr nil :read-only t)
  ;; FIXME refactoring: Should have an attribute `buffer' for the buffer this
  ;;                    title is found in.  This breaks lots and lots of tests.
  ;;                    However, with private constructor they may not be
  ;;                    necessary any more.  In case it is really a buffer then
  ;;                    also `match' could be real data from `match-data' which
  ;;                    contains markers instead of integers.
  )
926 927 928 929 930 931

;; Private class methods

(defun rst-Ttl--validate-ado (ado)
  ;; testcover: ok.
  "Return valid ADO or signal error."
932
  (cl-check-type ado (or null rst-Ado))
933 934 935 936 937
  ado)

(defun rst-Ttl--validate-match (match ado)
  ;; testcover: ok.
  "Return valid MATCH matching ADO or signal error."
938 939 940 941 942 943 944 945 946 947 948 949
  (cl-check-type ado (or null rst-Ado))
  (cl-check-type match list)
  (cl-check-type match (satisfies (lambda (m)
				    (equal (length m) 8)))
		 "Match data must consist of exactly 8 buffer positions.")
  (dolist (pos match)
    (cl-check-type pos (or null integer-or-marker)))
  (cl-destructuring-bind (all-beg all-end
			  ovr-beg ovr-end
			  txt-beg txt-end
			  und-beg und-end) match
    (unless (and (integer-or-marker-p all-beg) (integer-or-marker-p all-end))
950
      (signal 'args-out-of-range
951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977
	      '("First two elements of match data must be buffer positions.")))
    (cond
     ((null ado)
      (unless (and (null ovr-beg) (null ovr-end)
		   (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end)
		   (null und-beg) (null und-end))
	(signal 'args-out-of-range
		'("For a title candidate exactly the third match pair must be set."))))
     ((rst-Ado-is-transition ado)
      (unless (and (null ovr-beg) (null ovr-end)
		   (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end)
		   (null und-beg) (null und-end))
	(signal 'args-out-of-range
		'("For a transition exactly the third match pair must be set."))))
     ((rst-Ado-is-simple ado)
      (unless (and (null ovr-beg) (null ovr-end)
		   (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end)
		   (integer-or-marker-p und-beg) (integer-or-marker-p und-end))
	(signal 'args-out-of-range
		'("For a simple section adornment exactly the third and fourth match pair must be set."))))
     (t ; over-and-under
      (unless (and (integer-or-marker-p ovr-beg) (integer-or-marker-p ovr-end)
		   (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end)
		   (or (null und-beg) (integer-or-marker-p und-beg))
		   (or (null und-end) (integer-or-marker-p und-end)))
	(signal 'args-out-of-range
		'("For a over-and-under section adornment all match pairs must be set."))))))
978 979 980 981 982 983
  match)

(defun rst-Ttl--validate-indent (indent ado)
  ;; testcover: ok.
  "Return valid INDENT for ADO or signal error."
  (if (and ado (rst-Ado-is-transition ado))
984 985 986 987
      (cl-check-type indent null
		     "Indent for a transition must be nil.")
    (cl-check-type indent (integer 0 *)
		   "Indent for a section header must be non-negative."))
988 989 990 991 992 993
  indent)

(defun rst-Ttl--validate-text (text ado)
  ;; testcover: ok.
  "Return valid TEXT for ADO or signal error."
  (if (and ado (rst-Ado-is-transition ado))
994 995 996
      (cl-check-type text null
		     "Transitions may not have title text.")
    (cl-check-type text string))
997 998
  text)

999 1000 1001
;; Public class methods

(defun rst-Ttl-from-buffer (ado beg-ovr beg-txt beg-und txt)
1002
  ;; testcover: ok.
1003 1004 1005 1006 1007 1008
  "Return a `rst-Ttl' constructed from information in the current buffer.
ADO is the adornment or nil for a title candidate.  BEG-OVR and
BEG-UND are the starting points of the overline or underline,
respectively.  They may be nil if the respective thing is missing.
BEG-TXT is the beginning of the title line or the transition and
must be given.  The end of the line is used as the end point.  TXT
Paul Eggert's avatar
Paul Eggert committed
1009
is the title text or nil.  If TXT is given the indentation of the
1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032
line containing BEG-TXT is used as indentation.  Match group 0 is
derived from the remaining information."
  (cl-check-type beg-txt integer-or-marker)
  (save-excursion
    (let ((end-ovr (when beg-ovr
		     (goto-char beg-ovr)
		     (line-end-position)))
	  (end-txt (progn
		     (goto-char beg-txt)
		     (line-end-position)))
	  (end-und (when beg-und
		     (goto-char beg-und)
		     (line-end-position)))
	  (ind (when txt
		 (goto-char beg-txt)
		 (current-indentation))))
      (rst-Ttl--new ado
		    (list
		     (or beg-ovr beg-txt) (or end-und end-txt)
		     beg-ovr end-ovr
		     beg-txt end-txt
		     beg-und end-und)
		    ind txt))))
1033 1034 1035 1036 1037 1038 1039

;; Public methods

(defun rst-Ttl-get-title-beginning (self)
  ;; testcover: ok.
  "Return position of beginning of title text of SELF.
This position should always be at the start of a line."
1040
  (cl-check-type self rst-Ttl)
1041 1042 1043 1044 1045
  (nth 4 (rst-Ttl-match self)))

(defun rst-Ttl-get-beginning (self)
  ;; testcover: ok.
  "Return position of beginning of whole SELF."
1046
  (cl-check-type self rst-Ttl)
1047 1048 1049 1050 1051
  (nth 0 (rst-Ttl-match self)))

(defun rst-Ttl-get-end (self)
  ;; testcover: ok.
  "Return position of end of whole SELF."
1052
  (cl-check-type self rst-Ttl)
1053 1054
  (nth 1 (rst-Ttl-match self)))

1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079
(defun rst-Ttl-is-section (self)
  ;; testcover: ok.
  "Return non-nil if SELF is a section header or candidate."
  (cl-check-type self rst-Ttl)
  (rst-Ttl-text self))

(defun rst-Ttl-is-candidate (self)
  ;; testcover: ok.
  "Return non-nil if SELF is a candidate for a section header."
  (cl-check-type self rst-Ttl)
  (not (rst-Ttl-ado self)))

(defun rst-Ttl-contains (self position)
  "Return whether SELF contain POSITION.
Return 0 if SELF contains POSITION, < 0 if SELF ends before
POSITION and > 0 if SELF starts after position."
  (cl-check-type self rst-Ttl)
  (cl-check-type position integer-or-marker)
  (cond
   ((< (nth 1 (rst-Ttl-match self)) position)
    -1)
   ((> (nth 0 (rst-Ttl-match self)) position)
    +1)
   (0)))

1080 1081 1082 1083

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Class rst-Stn

1084
(cl-defstruct
1085
  (rst-Stn
1086
   (:constructor nil) ; Prevent creating unchecked values.
1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106
   ;; Construct while all parameters must be valid.
   (:constructor
    rst-Stn-new
    (ttl-arg
     level-arg
     children-arg
     &aux
     (ttl (rst-Stn--validate-ttl ttl-arg))
     (level (rst-Stn--validate-level level-arg ttl))
     (children (rst-Stn--validate-children children-arg ttl)))))
  "Representation of a section tree node.

This type is immutable."
  ;; The title of the node or nil for a missing node.
  (ttl nil :read-only t)
  ;; The level of the node in the tree. Negative for the (virtual) top level
  ;; node.
  (level nil :read-only t)
  ;; The list of children of the node.
  (children nil :read-only t))
1107 1108
;; FIXME refactoring: Should have an attribute `buffer' for the buffer this
;;                    title is found in. Or use `rst-Ttl-buffer'.
1109 1110 1111 1112 1113 1114

;; Private class methods

(defun rst-Stn--validate-ttl (ttl)
  ;; testcover: ok.
  "Return valid TTL or signal error."
1115
  (cl-check-type ttl (or null rst-Ttl))
1116 1117 1118 1119 1120
  ttl)

(defun rst-Stn--validate-level (level ttl)
  ;; testcover: ok.
  "Return valid LEVEL for TTL or signal error."
1121 1122 1123 1124 1125
  (cl-check-type level integer)
  (when (and ttl (< level 0))
    ;; testcover: Never reached because a title may not have a negative level
    (signal 'args-out-of-range
	    '("Top level node must not have a title.")))
1126 1127 1128 1129 1130
  level)

(defun rst-Stn--validate-children (children ttl)
  ;; testcover: ok.
  "Return valid CHILDREN for TTL or signal error."
1131 1132 1133
  (cl-check-type children list)
  (dolist (child children)
    (cl-check-type child rst-Stn))
1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144
  (unless (or ttl children)
    (signal 'args-out-of-range
	    '("A missing node must have children.")))
  children)

;; Public methods

(defun rst-Stn-get-title-beginning (self)
  ;; testcover: ok.
  "Return the beginning of the title of SELF.
Handles missing node properly."
1145
  (cl-check-type self rst-Stn)
1146 1147 1148 1149 1150 1151 1152 1153 1154
  (let ((ttl (rst-Stn-ttl self)))
    (if ttl
	(rst-Ttl-get-title-beginning ttl)
      (rst-Stn-get-title-beginning (car (rst-Stn-children self))))))

(defun rst-Stn-get-text (self &optional default)
  ;; testcover: ok.
  "Return title text of SELF or DEFAULT if SELF is a missing node.
For a missing node and no DEFAULT given return a standard title text."
1155
  (cl-check-type self rst-Stn)
1156 1157 1158 1159 1160 1161 1162 1163 1164 1165
  (let ((ttl (rst-Stn-ttl self)))
    (cond
     (ttl
      (rst-Ttl-text ttl))
     (default)
     ("[missing node]"))))

(defun rst-Stn-is-top (self)
  ;; testcover: ok.
  "Return non-nil if SELF is a top level node."
1166
  (cl-check-type self rst-Stn)
1167 1168
  (< (rst-Stn-level self) 0))

Stefan Monnier's avatar
Stefan Monnier committed
1169 1170

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1171
;; Mode definition
1172 1173

(defun rst-define-key (keymap key def &rest deprecated)