[Python-modules-commits] [python-docutils] 03/04: Update rst.el to the latest upstream version, 1.5.0
Dmitry Shachnev
mitya57 at moszumanska.debian.org
Mon Oct 31 14:23:37 UTC 2016
This is an automated email from the git hooks/post-receive script.
mitya57 pushed a commit to branch master
in repository python-docutils.
commit e427da2fff9eb5c41e4bc3d97c0dcdbf63bfecf8
Author: Dmitry Shachnev <mitya57 at gmail.com>
Date: Mon Oct 31 17:21:33 2016 +0300
Update rst.el to the latest upstream version, 1.5.0
Patch-Name: update-rstel.diff
---
tools/editors/emacs/rst.el | 2980 +++++++++++++++++++++++++-------------------
1 file changed, 1673 insertions(+), 1307 deletions(-)
diff --git a/tools/editors/emacs/rst.el b/tools/editors/emacs/rst.el
index 6c81ea2..9ecccca 100644
--- a/tools/editors/emacs/rst.el
+++ b/tools/editors/emacs/rst.el
@@ -1,9 +1,9 @@
;;; rst.el --- Mode for viewing and editing reStructuredText-documents.
-;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2016 Free Software Foundation, Inc.
-;; Maintainer: Stefan Merten <smerten at oekonux.de>
-;; Author: Stefan Merten <smerten at oekonux.de>,
+;; Maintainer: Stefan Merten <stefan at merten-home dot de>
+;; Author: Stefan Merten <stefan at merten-home dot de>,
;; Martin Blais <blais at furius.ca>,
;; David Goodger <goodger at python.org>,
;; Wei-Wei Guo <wwguocn at gmail.com>
@@ -53,10 +53,10 @@
;; For full details on how to use the contents of this file, see
;; http://docutils.sourceforge.net/docs/user/emacs.html
;;
-;;
-;; There are a number of convenient key bindings provided by rst-mode.
-;; For more on bindings, see rst-mode-map below. There are also many variables
-;; that can be customized, look for defcustom in this file.
+;; 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.
;;
;; If you use the table-of-contents feature, you may want to add a hook to
;; update the TOC automatically every time you adjust a section title::
@@ -68,11 +68,6 @@
;;
;; (setq font-lock-global-modes '(not rst-mode ...))
;;
-;;
-;;
-;; Customization is done by customizable variables contained in customization
-;; group "rst" and subgroups. Group "rst" is contained in the "wp" group.
-;;
;;; DOWNLOAD
@@ -110,15 +105,16 @@
;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*-
;; lexical-binding: t -*-" in the first line.
-;; FIXME: Use `testcover'.
+;; FIXME: Embed complicated `defconst's in `eval-when-compile'.
-;; FIXME: The adornment classification often called `ado' should be a
-;; `defstruct'.
+;; FIXME: Use `testcover'. Mark up a function with sufficient test coverage by
+;; a comment tagged with `testcover' after the `defun'.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support for `testcover'
-(when (boundp 'testcover-1value-functions)
+(when (and (boundp 'testcover-1value-functions)
+ (boundp 'testcover-compose-functions))
;; Below `lambda' is used in a loop with varying parameters and is thus not
;; 1valued.
(setq testcover-1value-functions
@@ -159,6 +155,7 @@ considered constants. Revert it with this function after each `defcustom'."
;; used from there.
(defun rst-signum (x)
+ ;; testcover: ok.
"Return 1 if X is positive, -1 if negative, 0 if zero."
(cond
((> x 0) 1)
@@ -166,6 +163,7 @@ considered constants. Revert it with this function after each `defcustom'."
(t 0)))
(defun rst-some (seq &optional pred)
+ ;; testcover: ok.
"Return non-nil if any element of SEQ yields non-nil when PRED is applied.
Apply PRED to each element of list SEQ until the first non-nil
result is yielded and return this result. PRED defaults to
@@ -179,6 +177,7 @@ result is yielded and return this result. PRED defaults to
(throw 'rst-some r))))))
(defun rst-position-if (pred seq)
+ ;; testcover: ok.
"Return position of first element satisfying PRED in list SEQ or nil."
(catch 'rst-position-if
(let ((i 0))
@@ -188,6 +187,7 @@ result is yielded and return this result. PRED defaults to
(incf i)))))
(defun rst-position (elem seq)
+ ;; testcover: ok.
"Return position of ELEM in list SEQ or nil.
Comparison done with `equal'."
;; Create a closure containing `elem' so the `lambda' always sees our
@@ -198,13 +198,22 @@ Comparison done with `equal'."
(equal elem e)))
seq)))
-;; FIXME: Embed complicated `defconst's in `eval-when-compile'.
+(defun rst-member-if (pred seq)
+ ;; testcover: ok.
+ "Return sublist of SEQ starting with the element whose car satisfies PRED."
+ (let (found)
+ (while (and (not found) seq)
+ (if (funcall pred (car seq))
+ (setq found seq)
+ (setq seq (cdr seq))))
+ found))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Versions
-;; testcover: ok.
(defun rst-extract-version (delim-re head-re re tail-re var &optional default)
+ ;; testcover: ok.
"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."
@@ -217,7 +226,7 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
;; Use CVSHeader to really get information from CVS and not other version
;; control systems.
(defconst rst-cvs-header
- "$CVSHeader: sm/rst_el/rst.el,v 1.326 2012-09-20 21:28:04 stefan Exp $")
+ "$CVSHeader: sm/rst_el/rst.el,v 1.599 2016/07/31 11:13:12 stefan Exp $")
(defconst rst-cvs-rev
(rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+"
" .*" rst-cvs-header "0.0")
@@ -231,22 +240,22 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match."
;; Use LastChanged... to really get information from SVN.
(defconst rst-svn-rev
(rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " "
- "$LastChangedRevision: 7515 $")
+ "$LastChangedRevision: 7963 $")
"The SVN revision of this file.
SVN revision is the upstream (docutils) revision.")
(defconst rst-svn-timestamp
(rst-extract-version "\\$" "LastChangedDate: " ".+?+" " "
- "$LastChangedDate: 2012-09-20 23:28:53 +0200 (Don, 20. Sep 2012) $")
+ "$LastChangedDate: 2016-07-31 14:13:21 +0300 (So, 31. Jul 2016) $")
"The SVN time stamp of this file.")
;; Maintained by the release process.
(defconst rst-official-version
(rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
- "%OfficialVersion: 1.4.0 %")
+ "%OfficialVersion: 1.5.0 %")
"Official version of the package.")
(defconst rst-official-cvs-rev
(rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
- "$Revision: 7515 $")
+ "$Revision: 7963 $")
"CVS revision of this file in the official version.")
(defconst rst-version
@@ -266,6 +275,9 @@ in parentheses follows the development revision and the time stamp.")
("1.3.0" . "24.3")
("1.3.1" . "24.3")
("1.4.0" . "24.3")
+ ("1.4.1" . "24.5")
+ ("1.4.2" . "24.5")
+ ("1.5.0" . "25.2")
))
(unless (assoc rst-official-version rst-package-emacs-version-alist)
@@ -275,10 +287,10 @@ in parentheses follows the development revision and the time stamp.")
(add-to-list 'customize-package-emacs-version-alist
(cons 'ReST rst-package-emacs-version-alist))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Initialize customization
-
(defgroup rst nil "Support for reStructuredText documents."
:group 'wp
:version "23.1"
@@ -295,7 +307,7 @@ in parentheses follows the development revision and the time stamp.")
;; syntax.
(defconst rst-bullets
;; Sorted so they can form a character class when concatenated.
- '(?- ?* ?+ ?\u2022 ?\u2023 ?\u2043)
+ '(?- ?* ?+ ?• ?‣ ?⁃)
"List of all possible bullet characters for bulleted lists.")
(defconst rst-uri-schemes
@@ -391,8 +403,8 @@ in parentheses follows the development revision and the time stamp.")
; item tag.
;; Inline markup (`ilm')
- (ilm-pfx (:alt "^" hws-prt "[-'\"([{<\u2018\u201c\u00ab\u2019/:]"))
- (ilm-sfx (:alt "$" hws-prt "[]-'\")}>\u2019\u201d\u00bb/:.,;!?\\]"))
+ (ilm-pfx (:alt "^" hws-prt "[-'\"([{<‘“«’/:]"))
+ (ilm-sfx (:alt "$" hws-prt "[]-'\")}>’”»/:.,;!?\\]"))
;; Inline markup content (`ilc')
(ilcsgl-tag "\\S ") ; A single non-white character.
@@ -441,7 +453,7 @@ in parentheses follows the development revision and the time stamp.")
(opt-tag (:shy optsta-tag optnam-tag optarg-tag "?")) ; A complete option.
;; Footnotes and citations (`fnc')
- (fncnam-prt "[^\]\n]") ; Part of a footnote or citation name.
+ (fncnam-prt "[^]\n]") ; Part of a footnote or citation name.
(fncnam-tag fncnam-prt "+") ; A footnote or citation name.
(fnc-tag "\\[" fncnam-tag "]") ; A complete footnote or citation tag.
(fncdef-tag-2 (:grp exm-sta)
@@ -488,8 +500,10 @@ in parentheses follows the development revision and the time stamp.")
; character.
;; Titles (`ttl')
- (ttl-tag "\\S *\\w\\S *") ; A title text.
- (ttl-beg lin-beg ttl-tag) ; A title text at the beginning of a line.
+ (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.
;; Directives and substitution definitions (`dir')
(dir-tag-3 (:grp exm-sta)
@@ -511,7 +525,7 @@ in parentheses follows the development revision and the time stamp.")
; colon tag.
;; Comments (`cmt')
- (cmt-sta-1 (:grp exm-sta) "[^\[|_\n]"
+ (cmt-sta-1 (:grp exm-sta) "[^[|_\n]"
(:alt "[^:\n]" (:seq ":" (:alt "[^:\n]" "$")))
"*$") ; Start of a comment block; first group is explicit markup
; start.
@@ -527,10 +541,10 @@ argument list for `rst-re'.")
(defvar rst-re-alist) ; Forward declare to use it in `rst-re'.
-;; FIXME: Use `sregex` or `rx` instead of re-inventing the wheel.
+;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel.
(rst-testcover-add-compose 'rst-re)
-;; testcover: ok.
(defun rst-re (&rest args)
+ ;; testcover: ok.
"Interpret ARGS as regular expressions and return a regex string.
Each element of ARGS may be one of the following:
@@ -601,26 +615,607 @@ After interpretation of ARGS the results are concatenated as for
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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".
+;;
+;; For lists a "s" is added to the name of the concepts.
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Class rst-Ado
+
+(defstruct
+ (rst-Ado
+ (:constructor nil) ;; Prevent creating unchecked values.
+ ;; 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."
+ (cond
+ ((not (characterp char))
+ (signal 'wrong-type-argument (list 'characterp char)))
+ ((memq char rst-adornment-chars)
+ char)
+ (t
+ (signal 'args-out-of-range
+ (list (format
+ "Character must be a valid adornment character, not '%s'"
+ char))))))
+
+;; Public methods
+
+(defun rst-Ado-is-transition (self)
+ ;; testcover: ok.
+ "Return non-nil if SELF is a transition adornment."
+ (unless (rst-Ado-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Ado-p self)))
+ (eq (rst-Ado--style self) 'transition))
+
+(defun rst-Ado-is-section (self)
+ ;; testcover: ok.
+ "Return non-nil if SELF is a section adornment."
+ (unless (rst-Ado-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Ado-p self)))
+ (not (rst-Ado-is-transition self)))
+
+(defun rst-Ado-is-simple (self)
+ ;; testcover: ok.
+ "Return non-nil if SELF is a simple section adornment."
+ (unless (rst-Ado-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Ado-p self)))
+ (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."
+ (unless (rst-Ado-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Ado-p self)))
+ (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."
+ (cond
+ ((not (rst-Ado-p self))
+ (signal 'wrong-type-argument
+ (list 'rst-Ado-p self)))
+ ((not (rst-Ado-p other))
+ (signal 'wrong-type-argument
+ (list 'rst-Ado-p other)))
+ ((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.
+ "Return position of of SELF in ADOS or nil."
+ (unless (rst-Ado-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Ado-p self)))
+ (lexical-let ((ado self)) ;; Create closure.
+ (rst-position-if (function (lambda (e)
+ (rst-Ado-equal ado e)))
+ ados)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Class rst-Hdr
+
+(defstruct
+ (rst-Hdr
+ (:constructor nil) ;; Prevent creating unchecked values.
+ ;; 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))))
+ (:copier rst-Hdr-copy)) ;; Not really needed for an immutable type.
+ "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."
+ (cond
+ ((not (integerp indent))
+ (signal 'wrong-type-argument
+ (list 'integerp 'null indent)))
+ ((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"))))
+ (indent))) ;; Implicitly over-and-under.
+
+(defun rst-Hdr--validate-ado (ado)
+ ;; testcover: ok.
+ "Validate ADO to be a valid adornment.
+Return ADO if so or signal an error otherwise."
+ (cond
+ ((not (rst-Ado-p ado))
+ (signal 'wrong-type-argument
+ (list 'rst-Ado-p ado)))
+ ((rst-Ado-is-transition ado)
+ (signal 'args-out-of-range
+ '("Adornment for header must not be transition.")))
+ (t
+ ado)))
+
+;; Public class methods
+
+(defun rst-Hdr-preferred-adornments ()
+ ;; testcover: ok.
+ "Return preferred adornments as list of `rst-Hdr'."
+ (mapcar (lambda (el)
+ (rst-Hdr-new-lax
+ (if (eq (cadr el) 'over-and-under)
+ (rst-Ado-new-over-and-under (car el))
+ (rst-Ado-new-simple (car el)))
+ (caddr el)))
+ 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."
+ (unless (rst-Hdr-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Hdr-p self)))
+ (let ((pos (rst-Ado-position (rst-Hdr-ado self) (rst-Hdr-ado-map hdrs))))
+ (and pos (nthcdr pos hdrs))))
+
+(defun rst-Hdr-ado-map (selfs)
+ ;; testcover: ok.
+ "Return `rst-Ado' list extracted from elements of SELFS."
+ (mapcar 'rst-Hdr-ado selfs))
+
+(defun rst-Hdr-get-char (self)
+ ;; testcover: ok.
+ "Return character of the adornment of SELF."
+ (unless (rst-Hdr-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Hdr-p self)))
+ (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."
+ (unless (rst-Hdr-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Hdr-p self)))
+ (rst-Ado-is-over-and-under (rst-Hdr-ado self)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Class rst-Ttl
+
+(defstruct
+ (rst-Ttl
+ (:constructor nil) ;; Prevent creating unchecked values.
+ ;; Construct with valid parameters for all attributes.
+ (:constructor
+ rst-Ttl-new
+ (ado-arg
+ match-arg
+ indent-arg
+ text-arg
+ &optional
+ hdr-arg
+ level-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))
+ (hdr (and hdr-arg (rst-Ttl--validate-hdr hdr-arg ado indent)))
+ (level (and level-arg (rst-Ttl--validate-level level-arg)))))
+ (:copier rst-Ttl-copy))
+ "Representation of a reStructuredText section header as found in the buffer.
+This type gathers information about an adorned part in the
+buffer. Thus only the basic attributes are immutable. Although
+the remaining attributes are `setf'-able the respective setters
+should be used."
+ ;; The adornment characteristics or nil for a title candidate.
+ (ado nil :read-only t)
+ ;; The match-data for `ado' as returned by `match-data'. 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.
+ (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.
+ (hdr nil)
+ ;; The hierarchical level of the section header starting with 0.
+ (level nil))
+
+;; Private class methods
+
+(defun rst-Ttl--validate-ado (ado)
+ ;; testcover: ok.
+ "Return valid ADO or signal error."
+ (unless (or (null ado) (rst-Ado-p ado))
+ (signal 'wrong-type-argument
+ (list 'null 'rst-Ado-p ado)))
+ ado)
+
+(defun rst-Ttl--validate-match (match ado)
+ ;; testcover: ok.
+ "Return valid MATCH matching ADO or signal error."
+ (unless (listp match)
+ (signal 'wrong-type-argument
+ (list 'listp match)))
+ (unless (equal (length match) 8)
+ (signal 'args-out-of-range
+ '("Match data must consist of exactly 8 buffer positions.")))
+ (mapcar (lambda (pos)
+ (unless (or (null pos) (integer-or-marker-p pos))
+ (signal 'wrong-type-argument
+ (list 'integer-or-marker-p 'null pos))))
+ match)
+ (unless (and (integer-or-marker-p (nth 0 match))
+ (integer-or-marker-p (nth 1 match)))
+ (signal 'args-out-of-range
+ '("First two elements of match data must be buffer positions.")))
+ (cond
+ ((null ado)
+ (unless (and (null (nth 2 match))
+ (null (nth 3 match))
+ (integer-or-marker-p (nth 4 match))
+ (integer-or-marker-p (nth 5 match))
+ (null (nth 6 match))
+ (null (nth 7 match)))
+ (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 (nth 2 match))
+ (null (nth 3 match))
+ (integer-or-marker-p (nth 4 match))
+ (integer-or-marker-p (nth 5 match))
+ (null (nth 6 match))
+ (null (nth 7 match)))
+ (signal 'args-out-of-range
+ '("For a transition exactly the third match pair must be set."))))
+ ((rst-Ado-is-simple ado)
+ (unless (and (null (nth 2 match))
+ (null (nth 3 match))
+ (integer-or-marker-p (nth 4 match))
+ (integer-or-marker-p (nth 5 match))
+ (integer-or-marker-p (nth 6 match))
+ (integer-or-marker-p (nth 7 match)))
+ (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 (nth 2 match))
+ (integer-or-marker-p (nth 3 match))
+ (integer-or-marker-p (nth 4 match))
+ (integer-or-marker-p (nth 5 match))
+ (or (null (nth 6 match)) (integer-or-marker-p (nth 6 match)))
+ (or (null (nth 7 match)) (integer-or-marker-p (nth 7 match))))
+ (signal 'args-out-of-range
+ '("For a over-and-under section adornment all match pairs must be set.")))))
+ 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))
+ (unless (null indent)
+ (signal 'args-out-of-range
+ '("Indent for a transition must be nil.")))
+ (unless (integerp indent)
+ (signal 'wrong-type-argument
+ (list 'integerp indent)))
+ (unless (>= indent 0)
+ (signal 'args-out-of-range
+ '("Indent for a section header must be non-negative."))))
+ indent)
+
+(defun rst-Ttl--validate-hdr (hdr ado indent)
+ ;; testcover: ok.
+ "Return valid HDR in relation to ADO and INDENT or signal error."
+ (unless (rst-Hdr-p hdr)
+ (signal 'wrong-type-argument
+ (list 'rst-Hdr-p hdr)))
+ (unless (rst-Ado-equal (rst-Hdr-ado hdr) ado)
+ (signal 'args-out-of-range
+ '("Basic adornment and adornment in header must match.")))
+ (unless (equal (rst-Hdr-indent hdr) indent)
+ (signal 'args-out-of-range
+ '("Basic indent and indent in header must match.")))
+ hdr)
+
+(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))
+ (unless (null text)
+ (signal 'args-out-of-range
+ '("Transitions may not have title text.")))
+ (unless (stringp text)
+ (signal 'wrong-type-argument
+ (list 'stringp text))))
+ text)
+
+(defun rst-Ttl--validate-level (level)
+ ;; testcover: ok.
+ "Return valid LEVEL or signal error."
+ (unless (integerp level)
+ (signal 'wrong-type-argument
+ (list 'integerp level)))
+ (unless (>= level 0)
+ (signal 'args-out-of-range
+ '("Level must be non-negative.")))
+ level)
+
+;; Public methods
+
+(defun rst-Ttl-evaluate-hdr (self)
+ ;; testcover: ok.
+ "Check for `ado' and `indent' in SELF forming a valid `rst-Hdr'.
+Set and return it or nil if no valid `rst-Hdr' can be formed."
+ (setf (rst-Ttl-hdr self)
+ (condition-case nil
+ (rst-Hdr-new (rst-Ttl-ado self) (rst-Ttl-indent self))
+ (error nil))))
+
+(defun rst-Ttl-set-level (self level)
+ ;; testcover: ok.
+ "In SELF set and return LEVEL or nil if invalid."
+ (setf (rst-Ttl-level self)
+ (rst-Ttl--validate-level level)))
+
+(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."
+ (nth 4 (rst-Ttl-match self)))
+
+(defun rst-Ttl-get-beginning (self)
+ ;; testcover: ok.
+ "Return position of beginning of whole SELF."
+ (nth 0 (rst-Ttl-match self)))
+
+(defun rst-Ttl-get-end (self)
+ ;; testcover: ok.
+ "Return position of end of whole SELF."
+ (nth 1 (rst-Ttl-match self)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Class rst-Stn
+
+(defstruct
+ (rst-Stn
+ (:constructor nil) ;; Prevent creating unchecked values.
+ ;; 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))
+
+;; Private class methods
+
+(defun rst-Stn--validate-ttl (ttl)
+ ;; testcover: ok.
+ "Return valid TTL or signal error."
+ (unless (or (null ttl) (rst-Ttl-p ttl))
+ (signal 'wrong-type-argument
+ (list 'null 'rst-Ttl-p ttl)))
+ ttl)
+
+(defun rst-Stn--validate-level (level ttl)
+ ;; testcover: ok.
+ "Return valid LEVEL for TTL or signal error."
+ (unless (integerp level)
+ (signal 'wrong-type-argument
+ (list 'integerp level)))
+ (when ttl
+ (unless (or (not (rst-Ttl-level ttl))
+ (equal (rst-Ttl-level ttl) level))
+ (signal 'args-out-of-range
+ '("A title must have correct level or none at all.")))
+ (when (< 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."))))
+ level)
+
+(defun rst-Stn--validate-children (children ttl)
+ ;; testcover: ok.
+ "Return valid CHILDREN for TTL or signal error."
+ (unless (listp children)
+ (signal 'wrong-type-argument
+ (list 'listp children)))
+ (mapcar (lambda (child)
+ (unless (rst-Stn-p child)
+ (signal 'wrong-type-argument
+ (list 'rst-Stn-p child))))
+ children)
+ (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."
+ (unless (rst-Stn-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Stn-p self)))
+ (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."
+ (unless (rst-Stn-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Stn-p self)))
+ (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."
+ (unless (rst-Stn-p self)
+ (signal 'wrong-type-argument
+ (list 'rst-Stn-p self)))
+ (< (rst-Stn-level self) 0))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mode definition
-;; testcover: ok.
(defun rst-define-key (keymap key def &rest deprecated)
+ ;; testcover: ok.
"Bind like `define-key' but add deprecated key definitions.
KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key
-definitions should be in vector notation. These are defined as
-well but give an additional message."
+definitions should be in vector notation. These are defined
+as well but give an additional message."
(define-key keymap key def)
- (dolist (dep-key deprecated)
- (define-key keymap dep-key
- `(lambda ()
- ,(format "Deprecated binding for %s, use \\[%s] instead." def def)
- (interactive)
- (call-interactively ',def)
- (message "[Deprecated use of key %s; use key %s instead]"
- (key-description (this-command-keys))
- (key-description ,key))))))
-
-;; Key bindings.
+ (when deprecated
+ (let* ((command-name (symbol-name def))
+ (forwarder-function-name
+ (if (string-match "^rst-\\(.*\\)$" command-name)
+ (concat "rst-deprecated-"
+ (match-string 1 command-name))
+ (error "Not an RST command: %s" command-name)))
+ (forwarder-function (intern forwarder-function-name)))
+ (unless (fboundp forwarder-function)
+ (defalias forwarder-function
+ (lexical-let ((key key) (def def))
+ (lambda ()
+ (interactive)
+ (call-interactively def)
+ (message "[Deprecated use of key %s; use key %s instead]"
+ (key-description (this-command-keys))
+ (key-description key))))
+ (format "Deprecated binding for %s, use \\[%s] instead."
+ def def)))
+ (dolist (dep-key deprecated)
+ (define-key keymap dep-key forwarder-function)))))
+
+ ;; Key bindings.
(defvar rst-mode-map
(let ((map (make-sparse-keymap)))
@@ -641,9 +1236,9 @@ well but give an additional message."
(rst-define-key map [?\C-c ?\C-a ?\C-a] 'rst-adjust)
;; Display the hierarchy of adornments implied by the current document
;; contents.
- (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-adornments-hierarchy)
+ (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-hdr-hierarchy)
;; Homogenize the adornments in the document.
- (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-adornments
+ (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-sections
[?\C-c ?\C-s])
;;
@@ -766,17 +1361,15 @@ This inherits from Text mode.")
(modify-syntax-entry ?\\ "\\" st)
(modify-syntax-entry ?_ "." st)
(modify-syntax-entry ?| "." st)
- (modify-syntax-entry ?\u00ab "." st)
- (modify-syntax-entry ?\u00bb "." st)
- (modify-syntax-entry ?\u2018 "." st)
- (modify-syntax-entry ?\u2019 "." st)
- (modify-syntax-entry ?\u201c "." st)
- (modify-syntax-entry ?\u201d "." st)
-
+ (modify-syntax-entry ?« "." st)
+ (modify-syntax-entry ?» "." st)
+ (modify-syntax-entry ?‘ "." st)
+ (modify-syntax-entry ?’ "." st)
+ (modify-syntax-entry ?“ "." st)
+ (modify-syntax-entry ?” "." st)
st)
"Syntax table used while in `rst-mode'.")
-
(defcustom rst-mode-hook nil
"Hook run when `rst-mode' is turned on.
The hook for `text-mode' is run before this one."
@@ -787,6 +1380,8 @@ The hook for `text-mode' is run before this one."
;; Pull in variable definitions silencing byte-compiler.
(require 'newcomment)
+(defvar electric-pair-pairs)
+
;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files
;; use *.txt, but this is too generic to be set as a default.
;;;###autoload (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode)))
@@ -805,65 +1400,62 @@ highlighting.
:group 'rst
;; Paragraph recognition.
- (set (make-local-variable 'paragraph-separate)
- (rst-re '(:alt
- "\f"
- lin-end)))
- (set (make-local-variable 'paragraph-start)
- (rst-re '(:alt
- "\f"
- lin-end
- (:seq hws-tag par-tag- bli-sfx))))
+ (setq-local paragraph-separate
+ (rst-re '(:alt
+ "\f"
+ lin-end)))
+ (setq-local paragraph-start
+ (rst-re '(:alt
+ "\f"
+ lin-end
+ (:seq hws-tag par-tag- bli-sfx))))
;; Indenting and filling.
- (set (make-local-variable 'indent-line-function) 'rst-indent-line)
- (set (make-local-variable 'adaptive-fill-mode) t)
- (set (make-local-variable 'adaptive-fill-regexp)
- (rst-re 'hws-tag 'par-tag- "?" 'hws-tag))
- (set (make-local-variable 'adaptive-fill-function) 'rst-adaptive-fill)
- (set (make-local-variable 'fill-paragraph-handle-comment) nil)
+ (setq-local indent-line-function 'rst-indent-line)
+ (setq-local adaptive-fill-mode t)
+ (setq-local adaptive-fill-regexp (rst-re 'hws-tag 'par-tag- "?" 'hws-tag))
+ (setq-local adaptive-fill-function 'rst-adaptive-fill)
+ (setq-local fill-paragraph-handle-comment nil)
;; Comments.
- (set (make-local-variable 'comment-start) ".. ")
- (set (make-local-variable 'comment-start-skip)
- (rst-re 'lin-beg 'exm-tag 'bli-sfx))
- (set (make-local-variable 'comment-continue) " ")
- (set (make-local-variable 'comment-multi-line) t)
- (set (make-local-variable 'comment-use-syntax) nil)
+ (setq-local comment-start ".. ")
+ (setq-local comment-start-skip (rst-re 'lin-beg 'exm-tag 'bli-sfx))
+ (setq-local comment-continue " ")
+ (setq-local comment-multi-line t)
+ (setq-local comment-use-syntax nil)
;; reStructuredText has not really a comment ender but nil is not really a
;; permissible value.
- (set (make-local-variable 'comment-end) "")
- (set (make-local-variable 'comment-end-skip) nil)
+ (setq-local comment-end "")
+ (setq-local comment-end-skip nil)
;; Commenting in reStructuredText is very special so use our own set of
;; functions.
- (set (make-local-variable 'comment-line-break-function)
- 'rst-comment-line-break)
- (set (make-local-variable 'comment-indent-function)
- 'rst-comment-indent)
- (set (make-local-variable 'comment-insert-comment-function)
- 'rst-comment-insert-comment)
- (set (make-local-variable 'comment-region-function)
- 'rst-comment-region)
- (set (make-local-variable 'uncomment-region-function)
- 'rst-uncomment-region)
+ (setq-local comment-line-break-function 'rst-comment-line-break)
+ (setq-local comment-indent-function 'rst-comment-indent)
+ (setq-local comment-insert-comment-function 'rst-comment-insert-comment)
+ (setq-local comment-region-function 'rst-comment-region)
+ (setq-local uncomment-region-function 'rst-uncomment-region)
+
+ (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`)))
;; Imenu and which function.
;; FIXME: Check documentation of `which-function' for alternative ways to
;; determine the current function name.
... 2985 lines suppressed ...
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/python-modules/packages/python-docutils.git
More information about the Python-modules-commits
mailing list