;;; rst.el --- Mode for viewing and editing reStructuredText-documents.
-;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2014 Free Software Foundation, Inc.
;; Maintainer: Stefan Merten <smerten@oekonux.de>
;; Author: Stefan Merten <smerten@oekonux.de>,
;;; INSTALLATION
-;; Add the following lines to your `.emacs' file:
+;; Add the following lines to your init file:
;;
;; (require 'rst)
;;
;;; Code:
+;; FIXME: Check through major mode conventions again.
+
+;; FIXME: Add proper ";;;###autoload" comments.
+
;; 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: The adornment classification often called `ado' should be a
+;; `defstruct'.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Support for `testcover'
+
+(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
+ (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
+ (lambda (sym)
+ (if (not (plist-member (symbol-plist sym) 'standard-value))
+ sym))
+ 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)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Common Lisp stuff
+
;; Only use of macros is allowed - may be replaced by `cl-lib' some time.
(eval-when-compile
(require 'cl))
(defun rst-some (seq &optional pred)
"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
+result is yielded and return this result. PRED defaults to
`identity'."
(unless pred
(setq pred 'identity))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Versions
+;; testcover: ok.
(defun rst-extract-version (delim-re head-re re tail-re var &optional default)
"Extract the version from a variable according to the given regexes.
Return the version after regex DELIM-RE and HEAD-RE matching RE
;; 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.287 2012-06-16 09:41:47 stefan Exp $")
+ "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.6 2012-10-07 13:05:50 stefan Exp $")
(defconst rst-cvs-rev
(rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+"
" .*" rst-cvs-header "0.0")
;; Use LastChanged... to really get information from SVN.
(defconst rst-svn-rev
(rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " "
- "$LastChangedRevision: 7444 $")
+ "$LastChangedRevision: 7515 $")
"The SVN revision of this file.
SVN revision is the upstream (docutils) revision.")
(defconst rst-svn-timestamp
(rst-extract-version "\\$" "LastChangedDate: " ".+?+" " "
- "$LastChangedDate: 2012-06-16 11:41:40 +0200 (Sat, 16 Jun 2012) $")
+ "$LastChangedDate: 2012-09-20 23:28:53 +0200 (Thu, 20 Sep 2012) $")
"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.3.0 %")
+ "%OfficialVersion: 1.4.0 %")
"Official version of the package.")
(defconst rst-official-cvs-rev
(rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
- "%Revision: 1.287 %")
+ "%Revision: 1.327 %")
"CVS revision of this file in the official version.")
(defconst rst-version
in parentheses follows the development revision and the time stamp.")
(defconst rst-package-emacs-version-alist
- '(("1.0.0" . "24.2")
- ("1.1.0" . "24.2")
- ("1.2.0" . "24.2")
- ("1.2.1" . "24.2")
- ("1.3.0" . "24.2")))
+ '(("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")
+ ("1.4.0" . "24.3")
+ ))
(unless (assoc rst-official-version rst-package-emacs-version-alist)
(error "Version %s not listed in `rst-package-emacs-version-alist'"
(defvar rst-re-alist) ; Forward declare to use it in `rst-re'.
;; FIXME: Use `sregex` or `rx` instead of re-inventing the wheel.
+(rst-testcover-add-compose 'rst-re)
+;; testcover: ok.
(defun rst-re (&rest args)
"Interpret ARGS as regular expressions and return a regex string.
Each element of ARGS may be one of the following:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Mode definition
+;; testcover: ok.
(defun rst-define-key (keymap key def &rest deprecated)
"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)))
;;
;; The adjustment function that adorns or rotates a section title.
(rst-define-key map [?\C-c ?\C-=] 'rst-adjust [?\C-c ?\C-a t])
- (rst-define-key map [?\C-=] 'rst-adjust) ; (Does not work on the Mac OSX.)
+ (rst-define-key map [?\C-=] 'rst-adjust) ; Does not work on the Mac OSX and
+ ; on consoles.
;; \C-c \C-a is the keymap for adornments.
(rst-define-key map [?\C-c ?\C-a ?\C-h] 'describe-prefix-bindings)
+ ;; Another binding which works with all types of input.
+ (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)
(modify-syntax-entry ?\u2019 "." st)
(modify-syntax-entry ?\u201c "." st)
(modify-syntax-entry ?\u201d "." 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."
:group 'rst
:type '(hook))
+(rst-testcover-defcustom)
;; 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)))
(set (make-local-variable 'uncomment-region-function)
'rst-uncomment-region)
+ (set (make-local-variable 'electric-pair-pairs)
+ '((?\" . ?\") (?\* . ?\*) (?\` . ?\`)))
+
+ ;; Imenu and which function.
+ ;; FIXME: Check documentation of `which-function' for alternative ways to
+ ;; determine the current function name.
+ (set (make-local-variable 'imenu-create-index-function)
+ 'rst-imenu-create-index)
+
;; Font lock.
(set (make-local-variable 'font-lock-defaults)
'(rst-font-lock-keywords
(add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t)
;; Text after a changed line may need new fontification.
- (set (make-local-variable 'jit-lock-contextually) t))
+ (set (make-local-variable 'jit-lock-contextually) t)
+
+ ;; Indentation is not deterministic.
+ (setq electric-indent-inhibit t))
;;;###autoload
(define-minor-mode rst-minor-mode
:version "21.1")
(define-obsolete-variable-alias
- 'rst-preferred-decorations 'rst-preferred-adornments "1.0.0")
+ 'rst-preferred-decorations 'rst-preferred-adornments "rst 1.0.0")
(defcustom rst-preferred-adornments '((?= over-and-under 1)
(?= simple 0)
(?- simple 0)
A list consisting of lists of the form (CHARACTER STYLE INDENT).
CHARACTER is the character used. STYLE is one of the symbols
-OVER-AND-UNDER or SIMPLE. INDENT is an integer giving the wanted
-indentation for STYLE OVER-AND-UNDER. CHARACTER and STYLE are
-always used when a section adornment is described. In other
-places t instead of a list stands for a transition.
+`over-and-under' or `simple'. INDENT is an integer giving the
+wanted indentation for STYLE `over-and-under'. CHARACTER and
+STYLE are always used when a section adornment is described.
+In other places, t instead of a list stands for a transition.
This sequence is consulted to offer a new adornment suggestion
when we rotate the underlines at the end of the existing
(const :tag "Underline only" simple))
(integer :tag "Indentation for overline and underline type"
:value 0))))
+(rst-testcover-defcustom)
(defcustom rst-default-indent 1
"Number of characters to indent the section title.
style."
:group 'rst-adjust
:type '(integer))
-
+(rst-testcover-defcustom)
(defun rst-compare-adornments (ado1 ado2)
"Compare adornments.
Return true if both ADO1 and ADO2 adornments are equal,
-according to restructured text semantics (only the character and
-the style are compared, the indentation does not matter)."
+according to restructured text semantics (only the character
+and the style are compared, the indentation does not matter)."
(and (eq (car ado1) (car ado2))
(eq (cadr ado1) (cadr ado2))))
(setq cur (cdr cur)))
cur))
-
+;; testcover: FIXME: Test with `rst-preferred-adornments' == nil. Add test
+;; `rst-adjust-no-preference'.
(defun rst-suggest-new-adornment (allados &optional prev)
"Suggest a new, different adornment from all that have been seen.
(defun rst-update-section (char style &optional indent)
"Unconditionally update the style of a section adornment.
-Do this using the given character CHAR, with STYLE 'simple
-or 'over-and-under, and with indent INDENT. If the STYLE
-is 'simple, whitespace before the title is removed (indent
+Do this using the given character CHAR, with STYLE `simple'
+or `over-and-under', and with indent INDENT. If the STYLE
+is `simple', whitespace before the title is removed (indent
is always assumed to be 0).
If there are existing overline and/or underline from the
len)
;; Fixup whitespace at the beginning and end of the line.
- (if (or (null indent) (eq style 'simple))
+ (if (or (null indent) (eq style 'simple)) ;; testcover: ok.
(setq indent 0))
(beginning-of-line)
(delete-horizontal-space)
;; Remove previous line if it is an adornment.
(save-excursion
- (forward-line -1)
+ (forward-line -1) ;; testcover: FIXME: Doesn't work when in first line
+ ;; of buffer.
(if (and (looking-at (rst-re 'ado-beg-2-1))
;; Avoid removing the underline of a title right above us.
(save-excursion (forward-line -1)
;; Remove following line if it is an adornment.
(save-excursion
- (forward-line +1)
+ (forward-line +1) ;; testcover: FIXME: Doesn't work when in last line
+ ;; of buffer.
(if (looking-at (rst-re 'ado-beg-2-1))
(rst-delete-entire-line))
;; Add a newline if we're at the end of the buffer, for the subsequence
(insert (make-string len char))))
;; Insert underline.
- (forward-line +1)
+ (1value ;; Line has been inserted above.
+ (forward-line +1))
(open-line 1)
(insert (make-string len char))
- (forward-line +1)
- (goto-char marker)
- ))
+ (1value ;; Line has been inserted above.
+ (forward-line +1))
+ (goto-char marker)))
(defun rst-classify-adornment (adornment end)
"Classify adornment for section titles and transitions.
(ado-re (rst-re ado-ch 'adorep3-hlp))
(end-pnt (point))
(beg-pnt (progn
- (forward-line 0)
+ (1value ;; No lines may be left to move.
+ (forward-line 0))
(point)))
(nxt-emp ; Next line nonexistent or empty
(save-excursion
(or (not (zerop (forward-line 1)))
+ ;; testcover: FIXME: Add test classifying at the end of
+ ;; buffer.
(looking-at (rst-re 'lin-end)))))
(prv-emp ; Previous line nonexistent or empty
(save-excursion
(ttl-blw ; Title found below starting here.
(save-excursion
(and
- (zerop (forward-line 1))
+ (zerop (forward-line 1)) ;; testcover: FIXME: Add test
+ ;; classifying at the end of
+ ;; buffer.
(looking-at (rst-re 'ttl-beg))
(point))))
(ttl-abv ; Title found above starting here.
(und-fnd ; Matching underline found starting here.
(save-excursion
(and ttl-blw
- (zerop (forward-line 2))
+ (zerop (forward-line 2)) ;; testcover: FIXME: Add test
+ ;; classifying at the end of
+ ;; buffer.
(looking-at (rst-re ado-re 'lin-end))
(point))))
(ovr-fnd ; Matching overline found starting here.
(setq key nil)))
(if key
(list key
- (or beg-ovr beg-txt beg-und)
- (or end-und end-txt end-ovr)
+ (or beg-ovr beg-txt)
+ (or end-und end-txt)
beg-ovr end-ovr beg-txt end-txt beg-und end-und)))))))
(defun rst-find-title-line ()
If no title line is found return nil.
Otherwise return as `rst-classify-adornment' does. However, if
-the title line has no syntactically valid adornment STYLE is nil
-in the first element. If there is no adornment around the title
+the title line has no syntactically valid adornment, STYLE is nil
+in the first element. If there is no adornment around the title,
CHARACTER is also nil and match groups for overline and underline
are nil."
(save-excursion
- (forward-line 0)
+ (1value ;; No lines may be left to move.
+ (forward-line 0))
(let ((orig-pnt (point))
(orig-end (line-end-position)))
(cond
(defvar rst-all-sections nil
"All section adornments in the buffer as found by `rst-find-all-adornments'.
-t when no section adornments were found.")
+Set to t when no section adornments were found.")
(make-variable-buffer-local 'rst-all-sections)
;; FIXME: If this variable is set to a different value font-locking of section
;; headers is wrong.
(defvar rst-section-hierarchy nil
"Section hierarchy in the buffer as determined by `rst-get-hierarchy'.
-t when no section adornments were found. Value depends on
-`rst-all-sections'.")
+Set to t when no section adornments were found.
+Value depends on `rst-all-sections'.")
(make-variable-buffer-local 'rst-section-hierarchy)
+(rst-testcover-add-1value 'rst-reset-section-caches)
(defun rst-reset-section-caches ()
"Reset all section cache variables.
Should be called by interactive functions which deal with sections."
(if (and cur (caar cur))
(setq next (if (= curline (caar cur)) (cdr cur) cur)))
- (mapcar 'cdar (list prev next))
- ))
-
+ (mapcar 'cdar (list prev next))))
(defun rst-adornment-complete-p (ado)
"Return true if the adornment ADO around point is complete."
(let* ((char (car ado))
(style (cadr ado))
(indent (caddr ado))
- (endcol (save-excursion (end-of-line) (current-column)))
- )
+ (endcol (save-excursion (end-of-line) (current-column))))
(if char
(let ((exps (rst-re "^" char (format "\\{%d\\}" (+ endcol indent)) "$")))
(and
(or (not (eq style 'over-and-under))
(save-excursion (forward-line -1)
(beginning-of-line)
- (looking-at exps))))
- ))
- ))
+ (looking-at exps))))))))
(defun rst-get-next-adornment
cur))
;; If not found, take the first of all adornments.
- suggestion
- )))
+ suggestion)))
;; FIXME: A line "``/`` full" is not accepted as a section title.
Adjust/rotate the section adornment for the section title around
point or promote/demote the adornments inside the region,
-depending on if the region is active. This function is meant to
-be invoked possibly multiple times, and can vary its behavior
+depending on whether the region is active. This function is meant
+to be invoked possibly multiple times, and can vary its behavior
with a positive PFXARG (toggle style), or with a negative
PFXARG (alternate behavior).
(reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0)))
(toggle-style (and pfxarg (not reverse-direction))))
- (if (rst-portable-mark-active-p)
+ (if (use-region-p)
;; Adjust adornments within region.
(rst-promote-region (and pfxarg t))
;; Adjust adornment around point.
(run-hooks 'rst-adjust-hook)
;; Make sure to reset the cursor position properly after we're done.
- (goto-char origpt)
-
- ))
+ (goto-char origpt)))
(defcustom rst-adjust-hook nil
"Hooks to be run after running `rst-adjust'."
:group 'rst-adjust
:type '(hook)
:package-version '(rst . "1.1.0"))
+(rst-testcover-defcustom)
(defcustom rst-new-adornment-down nil
"Controls level of new adornment for section headers."
(const :tag "Same level as previous one" nil)
(const :tag "One level down relative to the previous one" t))
:package-version '(rst . "1.1.0"))
+(rst-testcover-defcustom)
(defun rst-adjust-adornment (pfxarg)
"Call `rst-adjust-adornment-work' interactively.
1. a CHARACTER
-2. a STYLE which can be either of 'simple' or 'over-and-under'.
+2. a STYLE which can be either `simple' or `over-and-under'.
3. an INDENT (meaningful for the over-and-under style only)
which determines how many characters and over-and-under
If the current line does have an existing adornment, but the
adornment is incomplete, that is, the underline/overline does
-not extend to exactly the end of the title line (it is either too
-short or too long), we simply extend the length of the
+not extend to exactly the end of the title line (it is either
+too short or too long), we simply extend the length of the
underlines/overlines to fit exactly the section title.
If TOGGLE-STYLE we toggle the style of the adornment as well.
(region-begin-line (line-number-at-pos (region-beginning)))
(region-end-line (line-number-at-pos (region-end)))
- marker-list
- )
+ marker-list)
;; Skip the markers that come before the region beginning.
(while (and cur (< (caar cur) region-begin-line))
;; Clear marker to avoid slowing down the editing after we're done.
(set-marker (car p) nil))
- (setq deactivate-mark nil)
- )))
+ (setq deactivate-mark nil))))
(apply 'rst-update-section x)
(goto-char (point-max))
(insert "\n")
- (incf level)
- ))
- )))
+ (incf level))))))
(defun rst-straighten-adornments ()
"Redo all the adornments in the current buffer.
(apply 'rst-update-section (nth (car lm) rst-preferred-adornments))
;; Reset the marker to avoid slowing down editing until it gets GC'ed.
- (set-marker (cdr lm) nil)
- )
- )))
-
+ (set-marker (cdr lm) nil)))))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Obviously, NUM must be greater than zero. Don't blame me, blame the
Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with
apologies to Monty Python).
-If optional prefix ARG is non-nil, insert in current buffer."
+If optional ARG is non-nil, insert in current buffer."
(let ((map rst-arabic-to-roman)
res)
(while (and map (> num 0))
(setq res (concat res (cdar map))
num (- num (caar map)))
(setq map (cdr map))))
- res))
+ (if arg (insert (or res "")) res)))
(defun rst-roman-to-arabic (string &optional arg)
"Convert STRING of Roman numerals to an Arabic number.
-If STRING contains a letter which isn't a valid Roman numeral, the rest
-of the string from that point onwards is ignored.
+If STRING contains a letter which isn't a valid Roman numeral,
+the rest of the string from that point onwards is ignored.
Hence:
MMD == 2500
(setq res (+ res (caar map))
string (replace-match "" nil t string))
(setq map (cdr map))))
- res))
+ (if arg (insert res) res)))
;=================================================
(defun rst-find-pfx-in-region (beg end pfx-re)
(looking-at pfx-re)))))) ; ...pfx at same level.
(push (cons (point) (current-column))
pfx))
- (forward-line 1)) )
+ (forward-line 1)))
(nreverse pfx)))
(defun rst-insert-list-pos (newitem)
;; FIXME: Isn't this a `defconst'?
(defvar rst-initial-items
(append (mapcar 'char-to-string rst-bullets) rst-initial-enums)
- "List of initial items. It's collection of bullets and enumerations.")
+ "List of initial items. It's a collection of bullets and enumerations.")
(defun rst-insert-list-new-item ()
"Insert a new list item.
-User is asked to select the item style first, for example (a), i), +. Use TAB
-for completion and choices.
+User is asked to select the item style first, for example (a), i), +.
+Use TAB for completion and choices.
If user selects bullets or #, it's just added with position arranged by
`rst-insert-list-pos'.
-If user selects enumerations, a further prompt is given. User need to input a
-starting item, for example 'e' for 'A)' style. The position is also arranged by
-`rst-insert-list-pos'."
+If user selects enumerations, a further prompt is given. User need to
+input a starting item, for example 'e' for 'A)' style. The position is
+also arranged by `rst-insert-list-pos'."
(interactive)
;; FIXME: Make this comply to `interactive' standards.
(let* ((itemstyle (completing-read
:tag (char-to-string char) char))
rst-bullets)))
:package-version '(rst . "1.1.0"))
+(rst-testcover-defcustom)
(defun rst-insert-list-continue (curitem prefer-roman)
"Insert a list item with list start CURITEM including its indentation level.
The position of the new list is arranged according to whether or not the
current line and the previous line are blank lines.
-2. When continuing a list, one thing need to be noticed:
+2. When continuing a list, one thing needs to be noticed:
List style alphabetical list, such as 'a.', and roman numerical list, such as
'i.', have some overlapping items, for example 'v.' The function can deal with
;; Table of contents
;; =================
-(defun rst-get-stripped-line ()
- "Return the line at cursor, stripped from whitespace."
- (re-search-forward (rst-re "\\S .*\\S ") (line-end-position))
- (buffer-substring-no-properties (match-beginning 0)
- (match-end 0)) )
-
+;; FIXME: Return value should be a `defstruct'.
(defun rst-section-tree ()
- "Get the hierarchical tree of section titles.
-
-Returns a hierarchical tree of the sections titles in the
-document. This can be used to generate a table of contents for
-the document. The top node will always be a nil node, with the
-top level titles as children (there may potentially be more than
-one).
-
-Each section title consists in a cons of the stripped title
-string and a marker to the section in the original text document.
-
-If there are missing section levels, the section titles are
-inserted automatically, and the title string is set to nil, and
-the marker set to the first non-nil child of itself.
-Conceptually, the nil nodes--i.e.\ those which have no title--are
-to be considered as being the same line as their first non-nil
-child. This has advantages later in processing the graph."
-
+ "Return the hierarchical tree of section titles.
+A tree entry looks like ((TITLE MARKER) CHILD...). TITLE is the
+stripped text of the section title. MARKER is a marker for the
+beginning of the title text. For the top node or a missing
+section level node TITLE is nil and MARKER points to the title
+text of the first child. Each CHILD is another tree entry. The
+CHILD list may be empty."
(let ((hier (rst-get-hierarchy))
- (levels (make-hash-table :test 'equal :size 10))
- lines)
+ (ch-sty2level (make-hash-table :test 'equal :size 10))
+ lev-ttl-mrk-l)
(let ((lev 0))
(dolist (ado hier)
;; Compare just the character and indent in the hash table.
- (puthash (cons (car ado) (cadr ado)) lev levels)
+ (puthash (cons (car ado) (cadr ado)) lev ch-sty2level)
(incf lev)))
- ;; Create a list of lines that contains (text, level, marker) for each
- ;; adornment.
+ ;; Create a list that contains (LEVEL TITLE MARKER) for each adornment.
(save-excursion
- (setq lines
+ (setq lev-ttl-mrk-l
(mapcar (lambda (ado)
(goto-char (point-min))
- (forward-line (1- (car ado)))
- (list (gethash (cons (cadr ado) (caddr ado)) levels)
- (rst-get-stripped-line)
- (progn
- (beginning-of-line 1)
- (point-marker))))
+ (1value ;; This should really succeed.
+ (forward-line (1- (car ado))))
+ (list (gethash (cons (cadr ado) (caddr ado)) ch-sty2level)
+ ;; Get title.
+ (save-excursion
+ (if (re-search-forward
+ (rst-re "\\S .*\\S ") (line-end-position) t)
+ (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0))
+ ""))
+ (point-marker)))
(rst-find-all-adornments))))
- (let ((lcontnr (cons nil lines)))
- (rst-section-tree-rec lcontnr -1))))
-
-
-(defun rst-section-tree-rec (ados lev)
- "Recursive guts of the section tree construction.
-ADOS is a cons cell whose cdr is the remaining list of
-adornments, and we change it as we consume them. LEV is
-the current level of that node. This function returns a
-pair of the subtree that was built. This treats the ADOS
-list destructively."
-
- (let ((nado (cadr ados))
- node
- children)
-
- ;; If the next adornment matches our level.
- (when (and nado (= (car nado) lev))
- ;; Pop the next adornment and create the current node with it.
- (setcdr ados (cddr ados))
- (setq node (cdr nado)) )
- ;; Else we let the node title/marker be unset.
-
- ;; Build the child nodes.
- (while (and (cdr ados) (> (caadr ados) lev))
- (setq children
- (cons (rst-section-tree-rec ados (1+ lev))
- children)))
+ (cdr (rst-section-tree-rec lev-ttl-mrk-l -1))))
+
+;; FIXME: Return value should be a `defstruct'.
+(defun rst-section-tree-rec (remaining lev)
+ "Process the first entry of REMAINING expected to be on level LEV.
+REMAINING is the remaining list of adornments consisting
+of (LEVEL TITLE MARKER) entries.
+
+Return (UNPROCESSED (TITLE MARKER) CHILD...) for the first entry
+of REMAINING where TITLE is nil if the expected level is not
+matched. UNPROCESSED is the list of still unprocessed entries.
+Each CHILD is a child of this entry in the same format but
+without UNPROCESSED."
+ (let ((cur (car remaining))
+ (unprocessed remaining)
+ ttl-mrk children)
+ ;; If the current adornment matches expected level.
+ (when (and cur (= (car cur) lev))
+ ;; Consume the current entry and create the current node with it.
+ (setq unprocessed (cdr remaining))
+ (setq ttl-mrk (cdr cur)))
+
+ ;; Build the child nodes as long as they have deeper level.
+ (while (and unprocessed (> (caar unprocessed) lev))
+ (let ((rem-children (rst-section-tree-rec unprocessed (1+ lev))))
+ (setq children (cons (cdr rem-children) children))
+ (setq unprocessed (car rem-children))))
(setq children (reverse children))
- ;; If node is still unset, we use the marker of the first child.
- (when (eq node nil)
- (setq node (cons nil (cdaar children))))
-
- ;; Return this node with its children.
- (cons node children)
- ))
-
-
-(defun rst-section-tree-point (node &optional point)
- "Find tree node at point.
-Given a computed and valid section tree in NODE and a point
-POINT (default being the current point in the current buffer),
-find and return the node within the section tree where the cursor
-lives.
-
-Return values: a pair of (parent path, container subtree).
-The parent path is simply a list of the nodes above the
-container subtree node that we're returning."
-
- (let (path outtree)
-
- (let* ((curpoint (or point (point))))
-
- ;; Check if we are before the current node.
- (if (and (cadar node) (>= curpoint (cadar node)))
-
- ;; Iterate all the children, looking for one that might contain the
- ;; current section.
- (let ((curnode (cdr node))
- last)
-
- (while (and curnode (>= curpoint (cadaar curnode)))
- (setq last curnode
- curnode (cdr curnode)))
-
- (if last
- (let ((sub (rst-section-tree-point (car last) curpoint)))
- (setq path (car sub)
- outtree (cdr sub)))
- (setq outtree node))
-
- )))
- (cons (cons (car node) path) outtree)
- ))
-
+ (cons unprocessed
+ (cons (or ttl-mrk
+ ;; Node on this level missing - use nil as text and the
+ ;; marker of the first child.
+ (cons nil (cdaar children)))
+ children))))
+
+(defun rst-section-tree-point (tree &optional point)
+ "Return section containing POINT by returning the closest node in TREE.
+TREE is a section tree as returned by `rst-section-tree'
+consisting of (NODE CHILD...) entries. POINT defaults to the
+current point. A NODE must have the structure (IGNORED MARKER...).
+
+Return (PATH NODE CHILD...). NODE is the node where POINT is in
+if any. PATH is a list of nodes from the top of the tree down to
+and including NODE. List of CHILD are the children of NODE if any."
+ (setq point (or point (point)))
+ (let ((cur (car tree))
+ (children (cdr tree)))
+ ;; Point behind current node?
+ (if (and (cadr cur) (>= point (cadr cur)))
+ ;; Iterate all the children, looking for one that might contain the
+ ;; current section.
+ (let (found)
+ (while (and children (>= point (cadaar children)))
+ (setq found children
+ children (cdr children)))
+ (if found
+ ;; Found section containing point in children.
+ (let ((sub (rst-section-tree-point (car found) point)))
+ ;; Extend path with current node and return NODE CHILD... from
+ ;; sub.
+ (cons (cons cur (car sub)) (cdr sub)))
+ ;; Point in this section: Start a new path with current node and
+ ;; return current NODE CHILD...
+ (cons (list cur) tree)))
+ ;; Current node behind point: start a new path with current node and
+ ;; no NODE CHILD...
+ (list (list cur)))))
(defgroup rst-toc nil
"Settings for reStructuredText table of contents."
(defcustom rst-toc-indent 2
"Indentation for table-of-contents display.
Also used for formatting insertion, when numbering is disabled."
+ :type 'integer
:group 'rst-toc)
+(rst-testcover-defcustom)
(defcustom rst-toc-insert-style 'fixed
"Insertion style for table-of-contents.
Set this to one of the following values to determine numbering and
indentation style:
-- plain: no numbering (fixed indentation)
-- fixed: numbering, but fixed indentation
-- aligned: numbering, titles aligned under each other
-- listed: numbering, with dashes like list items (EXPERIMENTAL)"
+- `plain': no numbering (fixed indentation)
+- `fixed': numbering, but fixed indentation
+- `aligned': numbering, titles aligned under each other
+- `listed': numbering, with dashes like list items (EXPERIMENTAL)"
+ :type '(choice (const plain)
+ (const fixed)
+ (const aligned)
+ (const listed))
:group 'rst-toc)
+(rst-testcover-defcustom)
(defcustom rst-toc-insert-number-separator " "
"Separator that goes between the TOC number and the title."
+ :type 'string
:group 'rst-toc)
+(rst-testcover-defcustom)
;; This is used to avoid having to change the user's mode.
(defvar rst-toc-insert-click-keymap
(defcustom rst-toc-insert-max-level nil
"If non-nil, maximum depth of the inserted TOC."
+ :type '(choice (const nil) integer)
:group 'rst-toc)
-
+(rst-testcover-defcustom)
(defun rst-toc-insert (&optional pfxarg)
"Insert a simple text rendering of the table of contents.
(delete-region init-point (+ init-point (length initial-indent)))
;; Delete the last newline added.
- (delete-char -1)
- )))
+ (delete-char -1))))
(defun rst-toc-insert-node (node level indent pfx)
"Insert tree node NODE in table-of-contents.
-Recursive function that does printing of the inserted toc.
+Recursive function that does printing of the inserted TOC.
LEVEL is the depth level of the sections in the tree.
INDENT is the indentation string. PFX is the prefix numbering,
that includes the alignment necessary for all the children of
;; is generated automatically.
(put-text-property b (point) 'mouse-face 'highlight)
(put-text-property b (point) 'rst-toc-target (cadar node))
- (put-text-property b (point) 'keymap rst-toc-insert-click-keymap)
-
- )
+ (put-text-property b (point) 'keymap rst-toc-insert-click-keymap))
(insert "\n")
;; Prepare indent for children.
((eq rst-toc-insert-style 'listed)
(concat (substring indent 0 -3)
- (concat (make-string (+ (length pfx) 2) ? ) " - ")))
- ))
- )
+ (concat (make-string (+ (length pfx) 2) ? ) " - "))))))
(if (or (eq rst-toc-insert-max-level nil)
(< level rst-toc-insert-max-level))
;; for the numbers.
(if (cdr node)
(setq fmt (format "%%-%dd"
- (1+ (floor (log10 (length
- (cdr node))))))))
- ))
+ (1+ (floor (log (length (cdr node))
+ 10))))))))
(dolist (child (cdr node))
(rst-toc-insert-node child
indent
(if do-child-numbering
(concat pfx (format fmt count)) pfx))
- (incf count)))
-
- )))
+ (incf count))))))
(defun rst-toc-update ()
;; Add link on lines.
(put-text-property b (point) 'rst-toc-target (cadar node))
- (insert "\n")
- ))
+ (insert "\n")))
(dolist (child (cdr node))
(rst-toc-node child (1+ level))))
line
;; Create a temporary buffer.
- (buf (get-buffer-create rst-toc-buffer-name))
- )
+ (buf (get-buffer-create rst-toc-buffer-name)))
(with-current-buffer buf
(let ((inhibit-read-only t))
;; Count the lines to our found node.
(let ((linefound (rst-toc-count-lines sectree our-node)))
- (setq line (if (cdr linefound) (car linefound) 0)))
- ))
+ (setq line (if (cdr linefound) (car linefound) 0)))))
(display-buffer buf)
(pop-to-buffer buf)
;; Move the cursor near the right section in the TOC.
(goto-char (point-min))
- (forward-line (1- line))
- ))
+ (forward-line (1- line))))
(defun rst-toc-mode-find-section ()
;; paragraph.
(defun rst-goto-section (&optional kill)
"Go to the section the current line describes.
-If KILL a toc buffer is destroyed."
+If KILL a TOC buffer is destroyed."
(interactive)
(let ((pos (rst-toc-mode-find-section)))
(when kill
(defun rst-forward-section (&optional offset)
"Skip to the next reStructuredText section title.
-OFFSET specifies how many titles to skip. Use a negative OFFSET to move
-backwards in the file (default is to use 1)."
+OFFSET specifies how many titles to skip. Use a negative OFFSET
+to move backwards in the file (default is to use 1)."
(interactive)
(rst-reset-section-caches)
(let* (;; Default value for offset.
(curline (line-number-at-pos))
(cur allados)
- (idx 0)
- )
+ (idx 0))
;; Find the index of the "next" adornment w.r.t. to the current line.
(while (and cur (< (caar cur) curline))
(progn
(goto-char (point-min))
(forward-line (1- (car cur))))
- (if (> offset 0) (goto-char (point-max)) (goto-char (point-min))))
- ))
+ (if (> offset 0) (goto-char (point-max)) (goto-char (point-min))))))
(defun rst-backward-section ()
"Like `rst-forward-section', except move back one title."
(error "Cannot mark zero sections"))
(cond ((and allow-extend
(or (and (eq last-command this-command) (mark t))
- (rst-portable-mark-active-p)))
+ (use-region-p)))
(set-mark
(save-excursion
(goto-char (mark))
(valid (and (= curcol leftcol)
(not (looking-at (rst-re 'lin-end))))
(and (= curcol leftcol)
- (not (looking-at (rst-re 'lin-end)))))
- )
+ (not (looking-at (rst-re 'lin-end))))))
((>= (point) endm))
(if (if ,first-only
(and valid (not previous))
valid)
,body-consequent
- ,body-alternative)
-
- ))))
+ ,body-alternative)))))
;; FIXME: This needs to be refactored. Probably this is simply a function
;; applying BODY rather than a macro.
(,isleftmost (and (not ,isempty)
(= (current-column) ,leftmost))
(and (not ,isempty)
- (= (current-column) ,leftmost)))
- )
+ (= (current-column) ,leftmost))))
((>= (point) endm))
- (progn ,@body)
-
- )))))
+ (progn ,@body))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Indentation
(defgroup rst-indent nil "Settings for indentation in reStructuredText.
In reStructuredText indentation points are usually determined by
-preceding lines. Sometimes the syntax allows arbitrary
-indentation points such as where to start the first line
-following a directive. These indentation widths can be customized
-here."
+preceding lines. Sometimes the syntax allows arbitrary indentation
+points such as where to start the first line following a directive.
+These indentation widths can be customized here."
:group 'rst
:package-version '(rst . "1.1.0"))
(define-obsolete-variable-alias
- 'rst-shift-basic-offset 'rst-indent-width "1.0.0")
+ 'rst-shift-basic-offset 'rst-indent-width "rst 1.0.0")
(defcustom rst-indent-width 2
"Indentation when there is no more indentation point given."
:group 'rst-indent
:type '(integer))
+(rst-testcover-defcustom)
(defcustom rst-indent-field 3
"Indentation for first line after a field or 0 to always indent for content."
:group 'rst-indent
+ :package-version '(rst . "1.1.0")
:type '(integer))
+(rst-testcover-defcustom)
(defcustom rst-indent-literal-normal 3
"Default indentation for literal block after a markup on an own line."
:group 'rst-indent
+ :package-version '(rst . "1.1.0")
:type '(integer))
+(rst-testcover-defcustom)
(defcustom rst-indent-literal-minimized 2
"Default indentation for literal block after a minimized markup."
:group 'rst-indent
+ :package-version '(rst . "1.1.0")
:type '(integer))
+(rst-testcover-defcustom)
(defcustom rst-indent-comment 3
"Default indentation for first line of a comment."
:group 'rst-indent
+ :package-version '(rst . "1.1.0")
:type '(integer))
+(rst-testcover-defcustom)
;; FIXME: Must consider other tabs:
;; * Line blocks
(defun rst-compute-tabs (pt)
"Build the list of possible tabs for all lines above.
-Search backwards from point PT to build the list of possible
-tabs. Return a list of tabs sorted by likeliness to continue
-writing like `rst-line-tabs'. Nearer lines have generally a
-higher likeliness than farther lines. Return nil if no tab is found
-in the text above."
+Search backwards from point PT to build the list of possible tabs.
+Return a list of tabs sorted by likeliness to continue writing
+like `rst-line-tabs'. Nearer lines have generally a higher
+likeliness than farther lines. Return nil if no tab is found in
+the text above."
(save-excursion
(goto-char pt)
(let (leftmost ; Leftmost column found so far.
(indent-line-to ind)
(insert (comment-string-strip comment-start t t))))))
-(defun rst-uncomment-region (beg end &optional arg)
+(defun rst-uncomment-region (beg end &optional _arg)
"Uncomment the current region.
Region is from BEG to END. ARG is ignored"
(save-excursion
(let ((ins-string (format "%d. " (incf count))))
(setq last-insert-len (length ins-string))
(insert ins-string))
- (insert (make-string last-insert-len ?\ ))
- )))
+ (insert (make-string last-insert-len ?\ )))))
(defun rst-bullet-list-region (beg end all)
"Add bullets to all the leftmost paragraphs in the given region.
(rst-iterate-leftmost-paragraphs
beg end (not all)
(insert (car rst-preferred-bullets) " ")
- (insert " ")
- ))
+ (insert " ")))
;; FIXME: Does not deal with a varying number of digits appropriately.
;; FIXME: Does not deal with multiple levels independently.
(cons (copy-marker (car x))
(cdr x)))
(rst-find-pfx-in-region beg end (rst-re 'itmany-sta-1))))
- (count 1)
- )
+ (count 1))
(save-excursion
(dolist (x items)
(goto-char (car x))
(looking-at (rst-re 'itmany-beg-1))
(replace-match (format "%d." count) nil nil nil 1)
- (incf count)
- ))
- ))
-
-
+ (incf count)))))
;;------------------------------------------------------------------------------
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-block-face
"customize the face `rst-block' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-external-face
"customize the face `rst-external' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-definition-face
"customize the face `rst-definition' instead."
"24.1")
"Directives and roles."
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-directive-face
"customize the face `rst-directive' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-comment-face
"customize the face `rst-comment' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-emphasis1-face
"customize the face `rst-emphasis1' instead."
"24.1")
"Double emphasis."
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-emphasis2-face
"customize the face `rst-emphasis2' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-literal-face
"customize the face `rst-literal' instead."
"24.1")
:version "24.1"
:group 'rst-faces
:type '(face))
+(rst-testcover-defcustom)
(make-obsolete-variable 'rst-reference-face
"customize the face `rst-reference' instead."
"24.1")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; FIXME LEVEL-FACE: May be this complicated mechanism should be replaced
-;; simply by a number of customizable faces `rst-header-%d'
-;; which by default are set properly for dark and light
-;; background. Initialization should come from the old
-;; variables if they exist. A maximum level of 6 should
-;; suffice - after that the last level should be repeated.
-;; Only `rst-adornment-faces-alist' is needed outside this
-;; block. Would also fix docutils-Bugs-3479594.
-
-(defgroup rst-faces-defaults nil
- "Values used to generate default faces for section titles on all levels.
-Tweak these if you are content with how section title faces are built in
-general but you do not like the details."
- :group 'rst-faces
- :version "21.1")
-
-(defun rst-set-level-default (sym val)
- "Set custom variable SYM affecting section title text face.
-Recompute the faces. VAL is the value to set."
- (custom-set-default sym val)
- ;; Also defines the faces initially when all values are available.
- (and (boundp 'rst-level-face-max)
- (boundp 'rst-level-face-format-light)
- (boundp 'rst-level-face-base-color)
- (boundp 'rst-level-face-step-light)
- (boundp 'rst-level-face-base-light)
- (fboundp 'rst-define-level-faces)
- (rst-define-level-faces)))
-
-;; Faces for displaying items on several levels. These definitions define
-;; different shades of gray where the lightest one (i.e. least contrasting on a
-;; light background) is used for level 1.
-(defcustom rst-level-face-max 6
- "Maximum depth of levels for which section title faces are defined."
- :group 'rst-faces-defaults
- :type '(integer)
- :set 'rst-set-level-default)
-;; FIXME: It should be possible to give "#RRGGBB" type of color values.
-;; Together with a `rst-level-face-end-light' this could be used for
-;; computing steps.
-;; FIXME: This variable should be combined with `rst-level-face-format-light'
-;; to a single string.
-(defcustom rst-level-face-base-color "grey"
- "Base name of the color for creating background colors in section title faces."
- :group 'rst-faces-defaults
- :type '(string)
- :set 'rst-set-level-default)
-;; FIXME LEVEL-FACE: This needs to be done differently: The faces must specify
-;; how they behave for dark and light background using the
-;; relevant options explained in `defface'.
-(defcustom rst-level-face-base-light
- (if (eq frame-background-mode 'dark)
- 15
- 85)
- "The lightness factor for the base color. This value is used for level 1.
-The default depends on whether the value of `frame-background-mode' is
-`dark' or not."
- :group 'rst-faces-defaults
- :type '(integer)
- :set 'rst-set-level-default)
-(defcustom rst-level-face-format-light "%2d"
- "The format for the lightness factor appended to the base name of the color.
-This value is expanded by `format' with an integer."
- :group 'rst-faces-defaults
- :type '(string)
- :set 'rst-set-level-default)
-;; FIXME LEVEL-FACE: This needs to be done differently: The faces must specify
-;; how they behave for dark and light background using the
-;; relevant options explained in `defface'.
-;; FIXME: Alternatively there could be a customizable variable
-;; `rst-level-face-end-light' which defines the end value and steps are
-;; computed
-(defcustom rst-level-face-step-light
- (if (eq frame-background-mode 'dark)
- 7
- -7)
- "The step width to use for the next color.
-The formula
-
- `rst-level-face-base-light'
- + (`rst-level-face-max' - 1) * `rst-level-face-step-light'
-
-must result in a color level which appended to `rst-level-face-base-color'
-using `rst-level-face-format-light' results in a valid color such as `grey50'.
-This color is used as background for section title text on level
-`rst-level-face-max'."
- :group 'rst-faces-defaults
- :type '(integer)
- :set 'rst-set-level-default)
+(dolist (var '(rst-level-face-max rst-level-face-base-color
+ rst-level-face-base-light
+ rst-level-face-format-light
+ rst-level-face-step-light
+ rst-level-1-face
+ rst-level-2-face
+ rst-level-3-face
+ rst-level-4-face
+ rst-level-5-face
+ rst-level-6-face))
+ (make-obsolete-variable var "customize the faces `rst-level-*' instead."
+ "24.3"))
+
+;; Define faces for the first 6 levels. More levels are possible, however.
+(defface rst-level-1 '((((background light)) (:background "grey85"))
+ (((background dark)) (:background "grey15")))
+ "Default face for section title text at level 1."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-2 '((((background light)) (:background "grey78"))
+ (((background dark)) (:background "grey22")))
+ "Default face for section title text at level 2."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-3 '((((background light)) (:background "grey71"))
+ (((background dark)) (:background "grey29")))
+ "Default face for section title text at level 3."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-4 '((((background light)) (:background "grey64"))
+ (((background dark)) (:background "grey36")))
+ "Default face for section title text at level 4."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-5 '((((background light)) (:background "grey57"))
+ (((background dark)) (:background "grey43")))
+ "Default face for section title text at level 5."
+ :package-version '(rst . "1.4.0"))
+
+(defface rst-level-6 '((((background light)) (:background "grey50"))
+ (((background dark)) (:background "grey50")))
+ "Default face for section title text at level 6."
+ :package-version '(rst . "1.4.0"))
(defcustom rst-adornment-faces-alist
- ;; FIXME LEVEL-FACE: Must be redone if `rst-level-face-max' is changed
- (let ((alist (copy-sequence '((t . rst-transition)
- (nil . rst-adornment))))
- (i 1))
- (while (<= i rst-level-face-max)
- ;; FIXME: why not `push'?
- (nconc alist (list (cons i (intern (format "rst-level-%d-face" i)))))
- (setq i (1+ i)))
- alist)
- "Faces for the various adornment types.
+ '((t . rst-transition)
+ (nil . rst-adornment)
+ (1 . rst-level-1)
+ (2 . rst-level-2)
+ (3 . rst-level-3)
+ (4 . rst-level-4)
+ (5 . rst-level-5)
+ (6 . rst-level-6))
+ "Faces for the various adornment types.
Key is a number (for the section title text of that level
starting with 1), t (for transitions) or nil (for section title
-adornment). If you generally do not like how section title text
-faces are set up tweak here. If the general idea is ok for you
-but you do not like the details check the Rst Faces Defaults
-group."
+adornment). If you need levels beyond 6 you have to define faces
+of your own."
:group 'rst-faces
:type '(alist
:key-type
(integer :tag "Section level")
(const :tag "transitions" t)
(const :tag "section title adornment" nil))
- :value-type (face))
- :set-after '(rst-level-face-max))
-
-(defun rst-define-level-faces ()
- "Define the faces for the section title text faces from the values."
- ;; All variables used here must be checked in `rst-set-level-default'.
- (let ((i 1))
- (while (<= i rst-level-face-max)
- (let ((sym (intern (format "rst-level-%d-face" i)))
- (doc (format "Default face for showing section title text at level %d.
-This symbol is *not* meant for customization but modified if a
-variable of the `rst-faces-defaults' group is customized. Use
-`rst-adornment-faces-alist' for customization instead." i))
- (col (format (concat "%s" rst-level-face-format-light)
- rst-level-face-base-color
- (+ (* (1- i) rst-level-face-step-light)
- rst-level-face-base-light))))
- (make-empty-face sym)
- (set-face-doc-string sym doc)
- (set-face-background sym col)
- (set sym sym)
- (setq i (1+ i))))))
-
-;; FIXME LEVEL-FACE: This is probably superfluous since it is done by the
-;; customization / `rst-set-level-default'.
-(rst-define-level-faces)
+ :value-type (face)))
+(rst-testcover-defcustom)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Indentation is not required for doctest blocks.
(,(rst-re 'lin-beg '(:grp (:alt ">>>" ell-tag)) '(:grp ".+"))
(1 rst-block-face)
- (2 rst-literal-face))
- )
+ (2 rst-literal-face)))
"Keywords to highlight in rst mode.")
(defvar font-lock-beg)
(defvar rst-font-lock-find-unindented-line-end nil
"End of the match as determined by `rst-font-lock-find-unindented-line-limit'.
-Also used as a trigger for
-`rst-font-lock-find-unindented-line-match'.")
+Also used as a trigger for `rst-font-lock-find-unindented-line-match'.")
(defun rst-font-lock-find-unindented-line-limit (ind-pnt)
"Find the next unindented line relative to indentation at IND-PNT.
If IND-PNT is `next' take the indentation from the next line if
this is not empty and indented more than the current one. If
IND-PNT is non-nil but not a number take the indentation from the
-next non-empty line if this is indented more than the current
-one."
+next non-empty line if this is indented more than the current one."
(setq rst-font-lock-find-unindented-line-begin ind-pnt)
(setq rst-font-lock-find-unindented-line-end
(save-excursion
(or (rst-forward-indented-block nil (point-max))
(point-max))))))
-(defun rst-font-lock-find-unindented-line-match (limit)
+(defun rst-font-lock-find-unindented-line-match (_limit)
"Set the match found earlier if match were found.
-Match has been found by
-`rst-font-lock-find-unindented-line-limit' the first time called
-or no match is found. Return non-nil if match was found. LIMIT
-is not used but mandated by the caller."
+Match has been found by `rst-font-lock-find-unindented-line-limit'
+the first time called or no match is found. Return non-nil if
+match was found. LIMIT is not used but mandated by the caller."
(when rst-font-lock-find-unindented-line-end
(set-match-data
(list rst-font-lock-find-unindented-line-begin
(defun rst-adornment-level (key)
"Return section level for adornment KEY.
-KEY is the first element of the return list of
-`rst-classify-adornment'. If KEY is not a cons return it. If KEY is found
-in the hierarchy return its level. Otherwise return a level one
-beyond the existing hierarchy."
+KEY is the first element of the return list of `rst-classify-adornment'.
+If KEY is not a cons return it. If KEY is found in the hierarchy return
+its level. Otherwise return a level one beyond the existing hierarchy."
(if (not (consp key))
key
(let* ((hier (rst-get-hierarchy))
(defun rst-font-lock-handle-adornment-pre-match-form (ado ado-end)
"Determine limit for adornments.
Determine all things necessary for font-locking section titles
-and transitions and put the result to
-`rst-font-lock-adornment-match' and
-`rst-font-lock-adornment-level'. ADO is the complete adornment
+and transitions and put the result to `rst-font-lock-adornment-match'
+and `rst-font-lock-adornment-level'. ADO is the complete adornment
matched. ADO-END is the point where ADO ends. Return the point
where the whole adorned construct ends.
(goto-char (nth 1 ado-data)) ; Beginning of construct.
(nth 2 ado-data)))) ; End of construct.
-(defun rst-font-lock-handle-adornment-matcher (limit)
+(defun rst-font-lock-handle-adornment-matcher (_limit)
"Set the match found earlier if match were found.
Match has been found by
`rst-font-lock-handle-adornment-pre-match-form' the first time
extension of produced filename, options to the tool (nil or a
string)) to be used for converting the document."
;; FIXME: These are not options but symbols which may be referenced by
- ;; `rst-compile-*-toolset` below.
+ ;; `rst-compile-*-toolset` below. The `:validate' keyword of
+ ;; `defcustom' may help to define this properly in newer Emacs
+ ;; versions (> 23.1).
:type '(alist :options (html latex newlatex pseudoxml xml pdf s5)
:key-type symbol
:value-type (list :tag "Specification"
(choice :tag "Command options"
(const :tag "No options" nil)
(string :tag "Options"))))
- :group 'rst
+ :group 'rst-compile
:package-version "1.2.0")
+(rst-testcover-defcustom)
;; FIXME: Must be `defcustom`.
(defvar rst-compile-primary-toolset 'html
(setq prevdir dir)
(setq dir (expand-file-name (file-name-directory
(directory-file-name
- (file-name-directory dir)))))
- )
- (or (and dir (concat dir file-name)) nil)
- )))
-
+ (file-name-directory dir))))))
+ (or (and dir (concat dir file-name)) nil))))
(require 'compile)
(defun rst-compile (&optional use-alt)
"Compile command to convert reST document into some output file.
Attempts to find configuration file, if it can, overrides the
-options. There are two commands to choose from, with USE-ALT,
+options. There are two commands to choose from; with USE-ALT,
select the alternative tool-set."
(interactive "P")
;; Note: maybe we want to check if there is a Makefile too and not do anything
;; Invoke the compile command.
(if (or compilation-read-command use-alt)
(call-interactively 'compile)
- (compile compile-command))
- ))
+ (compile compile-command))))
(defun rst-compile-alt-toolset ()
"Compile command with the alternative tool-set."
))
\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Imenu support.
+
+;; FIXME: Integrate this properly. Consider a key binding.
+
+;; Based on code from Masatake YAMATO <yamato@redhat.com>.
+
+(defun rst-imenu-find-adornments-for-position (adornments pos)
+ "Find adornments cell in ADORNMENTS for position POS."
+ (let ((a nil))
+ (while adornments
+ (if (and (car adornments)
+ (eq (car (car adornments)) pos))
+ (setq a adornments
+ adornments nil)
+ (setq adornments (cdr adornments))))
+ a))
+
+(defun rst-imenu-convert-cell (elt adornments)
+ "Convert a cell ELT in a tree returned from `rst-section-tree' to Imenu index.
+ADORNMENTS is used as hint information for conversion."
+ (let* ((kar (car elt))
+ (kdr (cdr elt))
+ (title (car kar)))
+ (if kar
+ (let* ((p (marker-position (cadr kar)))
+ (adornments
+ (rst-imenu-find-adornments-for-position adornments p))
+ (a (car adornments))
+ (adornments (cdr adornments))
+ ;; FIXME: Overline adornment characters need to be in front so
+ ;; they become visible even for long title lines. May be
+ ;; an additional level number is also useful.
+ (title (format "%s%s%s"
+ (make-string (1+ (nth 3 a)) (nth 1 a))
+ title
+ (if (eq (nth 2 a) 'simple)
+ ""
+ (char-to-string (nth 1 a))))))
+ (cons title
+ (if (null kdr)
+ p
+ (cons
+ ;; A bit ugly but this make which-func happy.
+ (cons title p)
+ (mapcar (lambda (elt0)
+ (rst-imenu-convert-cell elt0 adornments))
+ kdr)))))
+ nil)))
+
+;; FIXME: Document title and subtitle need to be handled properly. They should
+;; get an own "Document" top level entry.
+(defun rst-imenu-create-index ()
+ "Create index for Imenu.
+Return as described for `imenu--index-alist'."
+ (rst-reset-section-caches)
+ (let ((tree (rst-section-tree))
+ ;; Translate line notation to point notation.
+ (adornments (save-excursion
+ (mapcar (lambda (ln-ado)
+ (cons (progn
+ (goto-char (point-min))
+ (forward-line (1- (car ln-ado)))
+ ;; FIXME: Need to consider
+ ;; `imenu-use-markers' here?
+ (point))
+ (cdr ln-ado)))
+ (rst-find-all-adornments)))))
+ (delete nil (mapcar (lambda (elt)
+ (rst-imenu-convert-cell elt adornments))
+ tree))))
+
+\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Generic text functions that are more convenient than the defaults.
;; be useful for creating separators.
(defun rst-repeat-last-character (use-next)
"Fill the current line using the last character on the current line.
-Fill up to the length of the preceding line or up to
-`fill-column' if preceding line is empty.
+Fill up to the length of the preceding line or up to `fill-column' if preceding
+line is empty.
If USE-NEXT, use the next line rather than the preceding line.
(cond ((equal last-command 'rst-repeat-last-character)
(if (= curcol fill-column) prevcol fill-column))
(t (save-excursion
- (if (zerop prevcol) fill-column prevcol)))
- )) )
+ (if (zerop prevcol) fill-column prevcol))))))
(end-of-line)
(if (> (current-column) rightmost-column)
;; Shave characters off the end.
(point))
;; Fill with last characters.
(insert-char (preceding-char)
- (- rightmost-column (current-column))))
- ))
-
-
-(defun rst-portable-mark-active-p ()
- "Return non-nil if the mark is active.
-This is a portable function."
- (cond
- ((fboundp 'region-active-p) (region-active-p))
- ((boundp 'transient-mark-mode) (and transient-mark-mode mark-active))
- (t mark-active)))
+ (- rightmost-column (current-column))))))
\f
HCoop / bpt / emacs.git / blobdiff