From 353371e31cb47db47071959faa8ea705eb3ae4b8 Mon Sep 17 00:00:00 2001 From: smerten Date: Thu, 20 Sep 2012 21:28:53 +0000 Subject: [PATCH] Add support for `imenu` and `which-func-mode`. Remember setting `which-func-modes` for this feature to work. Automated calculations of section title faces replaced by `defface`. Remove superfluous `rst-portable-mark-active-p`. Refactoring. Add support for `testcover`. git-svn-id: https://docutils.svn.sourceforge.net/svnroot/docutils/trunk@7515 929543f6-e4f2-0310-98a6-ba3bd3dd1d04 --- docutils/tools/editors/emacs/IDEAS.rst | 41 ++ docutils/tools/editors/emacs/rst.el | 732 +++++++++++---------- .../tools/editors/emacs/tests/adjust-section.el | 5 +- docutils/tools/editors/emacs/tests/adornment.el | 5 +- docutils/tools/editors/emacs/tests/buffer.el | 1 - docutils/tools/editors/emacs/tests/cl.el | 5 +- docutils/tools/editors/emacs/tests/comment.el | 5 +- docutils/tools/editors/emacs/tests/fill.el | 5 +- docutils/tools/editors/emacs/tests/font-lock.el | 5 +- docutils/tools/editors/emacs/tests/imenu.el | 111 ++++ docutils/tools/editors/emacs/tests/indent.el | 5 +- docutils/tools/editors/emacs/tests/init.el | 31 + docutils/tools/editors/emacs/tests/items.el | 5 +- docutils/tools/editors/emacs/tests/movement.el | 5 +- docutils/tools/editors/emacs/tests/re.el | 5 +- docutils/tools/editors/emacs/tests/shift.el | 5 +- docutils/tools/editors/emacs/tests/toc.el | 7 +- docutils/tools/editors/emacs/tests/tree.el | 202 ++++++ 18 files changed, 784 insertions(+), 396 deletions(-) create mode 100644 docutils/tools/editors/emacs/tests/imenu.el create mode 100644 docutils/tools/editors/emacs/tests/init.el create mode 100644 docutils/tools/editors/emacs/tests/tree.el diff --git a/docutils/tools/editors/emacs/IDEAS.rst b/docutils/tools/editors/emacs/IDEAS.rst index 4c1ee7717..20b68a160 100644 --- a/docutils/tools/editors/emacs/IDEAS.rst +++ b/docutils/tools/editors/emacs/IDEAS.rst @@ -123,6 +123,8 @@ TOC in speedbar * See `imenu` documentation and `speedbar-use-imenu-flag` + * See `speedbar` + toc-mode without markup ======================= @@ -218,6 +220,8 @@ Sophisticated filling should work as expected by *not* breaking the line + * May be `fill-nobreak-predicate` can help here + * These things may not be filled at all * Literal blocks @@ -228,6 +232,21 @@ Sophisticated filling * Link definitions + * May be `fill-nobreak-predicate` can help here, too + +* May be defining an own `auto-fill-function` may be useful + + * Might prevent auto-filling of literal text + +* Filling of a re-indented item doesn't work as expected:: + + * Something just indented once more by the user + though continuation line is not indented already + + * Alternatively indentation could indent the whole item + + * See `Sophisticated indentation`_ + Sophisticated indentation ========================= @@ -277,6 +296,15 @@ Sophisticated indentation * TTTTTTTT * ZZZZZZZZ +* An indenting tab on the head of a list item should indent the whole + list item instead of only the first line + + * Alternatively `fill-paragraph` could do so + + * See `Sophisticated filling`_ + +* May be `refill-mode` can be useful + List to sections ================ @@ -431,3 +459,16 @@ Intelligent quote insertion usable directly * Also add something like `delete-pair` + +Sophisticated alignment +======================= + +* May be aligning can be used to get results like this + + :Some: Field + + :Longer name: Aligned + + :Even longer name: More aligned + + * See `align.el` diff --git a/docutils/tools/editors/emacs/rst.el b/docutils/tools/editors/emacs/rst.el index 339df595c..ac70f197f 100644 --- a/docutils/tools/editors/emacs/rst.el +++ b/docutils/tools/editors/emacs/rst.el @@ -81,7 +81,7 @@ ;;; INSTALLATION -;; Add the following lines to your `.emacs' file: +;; Add the following lines to your init file: ;; ;; (require 'rst) ;; @@ -103,11 +103,54 @@ ;;; 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 (boundp 'testcover-1value-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)) @@ -160,6 +203,7 @@ Comparison done with `equal'." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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 @@ -173,7 +217,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.300 2012-07-30 19:24:36 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.326 2012-09-20 21:28:04 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -198,7 +242,7 @@ SVN revision is the upstream (docutils) revision.") ;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.3.1 %") + "%OfficialVersion: 1.4.0 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " @@ -215,12 +259,13 @@ Starts with the current official version. For developer versions 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.3.1" . "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) @@ -483,6 +528,8 @@ 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. +(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: @@ -556,6 +603,7 @@ After interpretation of ARGS the results are concatenated as for ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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 @@ -734,6 +782,7 @@ This inherits from Text mode.") 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) @@ -799,6 +848,12 @@ highlighting. (set (make-local-variable 'uncomment-region-function) 'rst-uncomment-region) + ;; 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 @@ -949,6 +1004,7 @@ file." (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. @@ -958,7 +1014,7 @@ from a simple adornment style to a over-and-under adornment style." :group 'rst-adjust :type '(integer)) - +(rst-testcover-defcustom) (defun rst-compare-adornments (ado1 ado2) "Compare adornments. @@ -979,7 +1035,8 @@ not found." (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. @@ -1032,7 +1089,7 @@ requested adornment." 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) @@ -1046,7 +1103,8 @@ requested adornment." ;; 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) @@ -1055,7 +1113,8 @@ requested adornment." ;; 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 @@ -1071,13 +1130,14 @@ requested adornment." (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. @@ -1104,11 +1164,14 @@ Return nil if no syntactically valid adornment is found." (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 @@ -1117,7 +1180,9 @@ Return nil if no syntactically valid adornment is found." (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. @@ -1129,7 +1194,9 @@ Return nil if no syntactically valid adornment is found." (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. @@ -1174,8 +1241,8 @@ Return nil if no syntactically valid adornment is found." (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 () @@ -1193,7 +1260,8 @@ 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 @@ -1253,6 +1321,7 @@ 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." @@ -1354,9 +1423,7 @@ Return a list of the previous and next adornments." (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." @@ -1369,8 +1436,7 @@ Return a list of the previous and next adornments." (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 @@ -1380,9 +1446,7 @@ Return a list of the previous and next adornments." (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 @@ -1414,8 +1478,7 @@ REVERSE-DIRECTION is used to reverse the cycling order." cur)) ;; If not found, take the first of all adornments. - suggestion - ))) + suggestion))) ;; FIXME: A line "``/`` full" is not accepted as a section title. @@ -1456,7 +1519,7 @@ b. a negative numerical argument, which generally inverts the (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. @@ -1466,15 +1529,14 @@ b. a negative numerical argument, which generally inverts the (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." @@ -1483,6 +1545,7 @@ b. a negative numerical argument, which generally inverts the (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. @@ -1741,8 +1804,7 @@ hierarchy is similar to that used by `rst-adjust-adornment-work'." (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)) @@ -1771,8 +1833,7 @@ hierarchy is similar to that used by `rst-adjust-adornment-work'." ;; 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)))) @@ -1792,9 +1853,7 @@ in ADORNMENTS." (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. @@ -1822,10 +1881,7 @@ in order to adapt it to our preferred style." (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))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1906,7 +1962,7 @@ and the column of the point." (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) @@ -2005,6 +2061,7 @@ starting item, for example 'e' for 'A)' style. The position is also arranged by :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. @@ -2123,130 +2180,112 @@ adjust. If bullets are found on levels beyond the ;; 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." @@ -2257,6 +2296,7 @@ container subtree node that we're returning." "Indentation for table-of-contents display. Also used for formatting insertion, when numbering is disabled." :group 'rst-toc) +(rst-testcover-defcustom) (defcustom rst-toc-insert-style 'fixed "Insertion style for table-of-contents. @@ -2267,10 +2307,12 @@ indentation style: - aligned: numbering, titles aligned under each other - listed: numbering, with dashes like list items (EXPERIMENTAL)" :group 'rst-toc) +(rst-testcover-defcustom) (defcustom rst-toc-insert-number-separator " " "Separator that goes between the TOC number and the title." :group 'rst-toc) +(rst-testcover-defcustom) ;; This is used to avoid having to change the user's mode. (defvar rst-toc-insert-click-keymap @@ -2282,7 +2324,7 @@ indentation style: (defcustom rst-toc-insert-max-level nil "If non-nil, maximum depth of the inserted TOC." :group 'rst-toc) - +(rst-testcover-defcustom) (defun rst-toc-insert (&optional pfxarg) "Insert a simple text rendering of the table of contents. @@ -2316,8 +2358,7 @@ The TOC is inserted indented at the current column." (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. @@ -2343,9 +2384,7 @@ level to align." ;; 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. @@ -2362,9 +2401,7 @@ level to align." ((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)) @@ -2382,8 +2419,7 @@ level to align." (if (cdr node) (setq fmt (format "%%-%dd" (1+ (floor (log10 (length - (cdr node)))))))) - )) + (cdr node)))))))))) (dolist (child (cdr node)) (rst-toc-insert-node child @@ -2391,9 +2427,7 @@ level to align." indent (if do-child-numbering (concat pfx (format fmt count)) pfx)) - (incf count))) - - ))) + (incf count)))))) (defun rst-toc-update () @@ -2468,8 +2502,7 @@ file-write hook to always make it up-to-date automatically." ;; 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)))) @@ -2517,8 +2550,7 @@ brings the cursor in that section." 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)) @@ -2531,8 +2563,7 @@ brings the cursor in that section." ;; 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) @@ -2541,8 +2572,7 @@ brings the cursor in that section." ;; 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 () @@ -2644,8 +2674,7 @@ backwards in the file (default is to use 1)." (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)) @@ -2666,8 +2695,7 @@ backwards in the file (default is to use 1)." (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." @@ -2686,7 +2714,7 @@ for negative COUNT." (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)) @@ -2742,17 +2770,14 @@ of each paragraph only." (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. @@ -2785,13 +2810,10 @@ first of a paragraph." (,isleftmost (and (not ,isempty) (= (current-column) ,leftmost)) (and (not ,isempty) - (= (current-column) ,leftmost))) - ) + (= (current-column) ,leftmost)))) ((>= (point) endm)) - (progn ,@body) - - ))))) + (progn ,@body)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indentation @@ -2817,26 +2839,31 @@ here." "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 :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 :type '(integer)) +(rst-testcover-defcustom) (defcustom rst-indent-literal-minimized 2 "Default indentation for literal block after a minimized markup." :group 'rst-indent :type '(integer)) +(rst-testcover-defcustom) (defcustom rst-indent-comment 3 "Default indentation for first line of a comment." :group 'rst-indent :type '(integer)) +(rst-testcover-defcustom) ;; FIXME: Must consider other tabs: ;; * Line blocks @@ -3116,8 +3143,7 @@ do all lines instead of just paragraphs." (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. @@ -3127,8 +3153,7 @@ do all lines instead of just paragraphs." (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. @@ -3143,18 +3168,13 @@ Renumber as necessary. Region is from BEG to END." (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))))) ;;------------------------------------------------------------------------------ @@ -3202,6 +3222,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too." :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") @@ -3216,6 +3237,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too." :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") @@ -3230,6 +3252,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too." :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") @@ -3246,6 +3269,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too." "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") @@ -3260,6 +3284,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too." :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") @@ -3274,6 +3299,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too." :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") @@ -3287,6 +3313,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too." "Double emphasis." :group 'rst-faces :type '(face)) +(rst-testcover-defcustom) (make-obsolete-variable 'rst-emphasis2-face "customize the face `rst-emphasis2' instead." "24.1") @@ -3301,6 +3328,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too." :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") @@ -3315,6 +3343,7 @@ Region is from RBEG to REND. With PFXARG set the empty lines too." :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") @@ -3331,113 +3360,64 @@ Region is from RBEG to REND. With PFXARG set the empty lines too." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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 @@ -3445,32 +3425,8 @@ group." (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) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3663,8 +3619,7 @@ variable of the `rst-faces-defaults' group is customized. Use ;; 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) @@ -3974,6 +3929,7 @@ string)) to be used for converting the document." (string :tag "Options")))) :group 'rst :package-version "1.2.0") +(rst-testcover-defcustom) ;; FIXME: Must be `defcustom`. (defvar rst-compile-primary-toolset 'html @@ -3999,11 +3955,8 @@ string)) to be used for converting the document." (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) @@ -4041,8 +3994,7 @@ select the alternative tool-set." ;; 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." @@ -4097,6 +4049,79 @@ buffer, if the region is not selected." )) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Imenu support. + +;; FIXME: Integrate this properly. Consider a key binding. + +;; Based on code from Masatake YAMATO . + +(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)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Generic text functions that are more convenient than the defaults. @@ -4166,8 +4191,7 @@ column is used (fill-column vs. end of previous/next 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. @@ -4176,17 +4200,7 @@ column is used (fill-column vs. end of previous/next line)." (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)))))) diff --git a/docutils/tools/editors/emacs/tests/adjust-section.el b/docutils/tools/editors/emacs/tests/adjust-section.el index 726a22d3c..3c673b29c 100644 --- a/docutils/tools/editors/emacs/tests/adjust-section.el +++ b/docutils/tools/editors/emacs/tests/adjust-section.el @@ -1,9 +1,8 @@ ;; Tests for rst-adjust (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest adjust-section-asserts () "Check some assertions." diff --git a/docutils/tools/editors/emacs/tests/adornment.el b/docutils/tools/editors/emacs/tests/adornment.el index 14cd229e7..10d18c07e 100644 --- a/docutils/tools/editors/emacs/tests/adornment.el +++ b/docutils/tools/editors/emacs/tests/adornment.el @@ -1,9 +1,8 @@ ;; Tests for various functions handling adornments (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest adornment-asserts () "Check some assertions." diff --git a/docutils/tools/editors/emacs/tests/buffer.el b/docutils/tools/editors/emacs/tests/buffer.el index 23aad45c4..088db73ef 100644 --- a/docutils/tools/editors/emacs/tests/buffer.el +++ b/docutils/tools/editors/emacs/tests/buffer.el @@ -1,6 +1,5 @@ ;;; buffer.el --- Test the test support for buffers - (add-to-list 'load-path ".") (load "ert-buffer" nil t) diff --git a/docutils/tools/editors/emacs/tests/cl.el b/docutils/tools/editors/emacs/tests/cl.el index 5708c3a7e..794cbb6a7 100644 --- a/docutils/tools/editors/emacs/tests/cl.el +++ b/docutils/tools/editors/emacs/tests/cl.el @@ -1,7 +1,8 @@ ;; Tests for replacement functions for `cl.el' -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(add-to-list 'load-path ".") +(load "init" nil t) +(init-rst-ert nil) (ert-deftest rst-signum () "Test `rst-signum'." diff --git a/docutils/tools/editors/emacs/tests/comment.el b/docutils/tools/editors/emacs/tests/comment.el index 80d791578..0070aeb9b 100644 --- a/docutils/tools/editors/emacs/tests/comment.el +++ b/docutils/tools/editors/emacs/tests/comment.el @@ -1,9 +1,8 @@ ;; Tests for comment handling (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest comment-asserts () "Check some assertions." diff --git a/docutils/tools/editors/emacs/tests/fill.el b/docutils/tools/editors/emacs/tests/fill.el index 704f42bb6..1a29cd638 100644 --- a/docutils/tools/editors/emacs/tests/fill.el +++ b/docutils/tools/editors/emacs/tests/fill.el @@ -1,9 +1,8 @@ ;; Tests for functions around filling (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest fill-asserts () "Check some assertions." diff --git a/docutils/tools/editors/emacs/tests/font-lock.el b/docutils/tools/editors/emacs/tests/font-lock.el index f20ce4acc..fb7fc6715 100644 --- a/docutils/tools/editors/emacs/tests/font-lock.el +++ b/docutils/tools/editors/emacs/tests/font-lock.el @@ -1,9 +1,8 @@ ;; Tests for font-locking code (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest font-lock--asserts () "Check some assertions." diff --git a/docutils/tools/editors/emacs/tests/imenu.el b/docutils/tools/editors/emacs/tests/imenu.el new file mode 100644 index 000000000..e21561b93 --- /dev/null +++ b/docutils/tools/editors/emacs/tests/imenu.el @@ -0,0 +1,111 @@ +;; Tests for rst-imenu-create-index + +(add-to-list 'load-path ".") +(load "init" nil t) +(init-rst-ert t) + +(ert-deftest imenu-asserts () + "Check some assertions." + (should (equal ert-Buf-point-char "\^@")) + (should (equal ert-Buf-mark-char "\^?")) + ) + +(ert-deftest rst-imenu-create-index () + "Tests for `rst-imenu-create-index'." + (should (ert-equal-buffer-return + (rst-imenu-create-index) + " +" + t + nil)) + (should (ert-equal-buffer-return + (rst-imenu-create-index) + " +Some normal text. +" + t + nil)) + (should (ert-equal-buffer-return + (rst-imenu-create-index) + " +Header +======" + t + '(("=Header" . 2)))) + (should (ert-equal-buffer-return + (rst-imenu-create-index) + " +Header +====== + +Subheader +---------" + t + '(("=Header" + ("=Header" . 2) + ("-Subheader" . 17))))) + (should (ert-equal-buffer-return + (rst-imenu-create-index) + " +Header +====== + +Subheader +--------- + +With space +----------" + t + '(("=Header" + ("=Header" . 2) + ("-Subheader" . 17) + ("-With space" . 38))))) + (should (ert-equal-buffer-return + (rst-imenu-create-index) + " +Header +====== + +Subheader +--------- + +With space +---------- + +Top level again +===============" + t + '(("=Header" + ("=Header" . 2) + ("-Subheader" . 17) + ("-With space" . 38)) + ("=Top level again" . 61)))) + (should (ert-equal-buffer-return + (rst-imenu-create-index) + " +Header +====== + +Subheader +--------- + +With space +---------- + +Sub sub +~~~~~~~ + +Top level again +===============" + t + '(("=Header" + ("=Header" . 2) + ("-Subheader" . 17) + ("-With space" + ("-With space" . 38) + ("~Sub sub" . 61))) + ("=Top level again" . 78)))) + ) + +;; FIXME: Test missing intermediate sections. +;; FIXME: Test document titles. diff --git a/docutils/tools/editors/emacs/tests/indent.el b/docutils/tools/editors/emacs/tests/indent.el index dbd2d1da0..18e2ca952 100644 --- a/docutils/tools/editors/emacs/tests/indent.el +++ b/docutils/tools/editors/emacs/tests/indent.el @@ -1,9 +1,8 @@ ;; Tests for functions around indentation (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest indent-asserts () "Check some assertions." diff --git a/docutils/tools/editors/emacs/tests/init.el b/docutils/tools/editors/emacs/tests/init.el new file mode 100644 index 000000000..caf9a1c42 --- /dev/null +++ b/docutils/tools/editors/emacs/tests/init.el @@ -0,0 +1,31 @@ +;; Initialize tests + +(defun init-rst-ert (&optional with-buffer) + "Initialize tests. +Prepare for buffer using tests if WITH-BUFFER." + (when with-buffer + (add-to-list 'load-path ".") + (load "ert-buffer" nil t) + (if (equal (car load-path) ".") + (setq load-path (cdr load-path)))) + + (add-to-list 'load-path "..") + (load "rst.el" nil t) + (if (equal (car load-path) "..") + (setq load-path (cdr load-path))) + + ;; Emacs 24 should have a patch in `testcover-after` declaring a + ;; `gv-expander'. + (if (< emacs-major-version 24) + ;; Define a setf-method for `testcover-after' so `ert' tests can be run + ;; without problems. + (defsetf testcover-after (idx val) (store) + (list 'progn + (list 'testcover-after idx val) + ;; FIXME: Though it solves the problem it is not really correct + ;; because `val' is only a temporary variable here. + (list 'setf val store))))) + +;; Clean up `load-path' if set caller just to load this file. +(if (equal (car load-path) ".") + (setq load-path (cdr load-path))) diff --git a/docutils/tools/editors/emacs/tests/items.el b/docutils/tools/editors/emacs/tests/items.el index 1c3c7268d..e86af1d43 100644 --- a/docutils/tools/editors/emacs/tests/items.el +++ b/docutils/tools/editors/emacs/tests/items.el @@ -1,9 +1,8 @@ ;; Tests for operations on list items (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest items-asserts () "Check some assertions." diff --git a/docutils/tools/editors/emacs/tests/movement.el b/docutils/tools/editors/emacs/tests/movement.el index fcfc9ca84..a6d66fef0 100644 --- a/docutils/tools/editors/emacs/tests/movement.el +++ b/docutils/tools/editors/emacs/tests/movement.el @@ -1,9 +1,8 @@ ;; Tests for various movement commands (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest movement-asserts () "Check some assertions." diff --git a/docutils/tools/editors/emacs/tests/re.el b/docutils/tools/editors/emacs/tests/re.el index df0b0b2b5..979a2b5c9 100644 --- a/docutils/tools/editors/emacs/tests/re.el +++ b/docutils/tools/editors/emacs/tests/re.el @@ -1,9 +1,8 @@ ;; Tests for the regular expression builder (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest rst-re () "Tests `rst-re'." diff --git a/docutils/tools/editors/emacs/tests/shift.el b/docutils/tools/editors/emacs/tests/shift.el index f966b266a..ea30cf5e0 100644 --- a/docutils/tools/editors/emacs/tests/shift.el +++ b/docutils/tools/editors/emacs/tests/shift.el @@ -1,9 +1,8 @@ ;; Tests for various functions around shifting text (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest shift-asserts () "Check some assertions." diff --git a/docutils/tools/editors/emacs/tests/toc.el b/docutils/tools/editors/emacs/tests/toc.el index e11d5dbb1..1f53c8d63 100644 --- a/docutils/tools/editors/emacs/tests/toc.el +++ b/docutils/tools/editors/emacs/tests/toc.el @@ -1,9 +1,8 @@ ;; Tests for operations on toc (add-to-list 'load-path ".") -(load "ert-buffer" nil t) -(add-to-list 'load-path "..") -(load "rst.el" nil t) +(load "init" nil t) +(init-rst-ert t) (ert-deftest toc-asserts () "Check some assertions." @@ -151,6 +150,6 @@ Header C ) )) -;; More functions to test: +;; FIXME: More functions to test: ;; * rst-toc ;; * rst-toc-mode-goto-section diff --git a/docutils/tools/editors/emacs/tests/tree.el b/docutils/tools/editors/emacs/tests/tree.el new file mode 100644 index 000000000..5c475430f --- /dev/null +++ b/docutils/tools/editors/emacs/tests/tree.el @@ -0,0 +1,202 @@ +;; Tests for `rst-section-tree' + +(add-to-list 'load-path ".") +(load "init" nil t) +(init-rst-ert t) + +(ert-deftest toc-asserts () + "Check some assertions." + (should (equal ert-Buf-point-char "\^@")) + (should (equal ert-Buf-mark-char "\^?")) + ) + +(defun mrk2int (obj) + "Replace all markers in OBJ by integers and return result." + (cond + ((markerp obj) + (marker-position obj)) + ((stringp obj) + obj) + ((sequencep obj) + (mapcar 'mrk2int obj)) + (t obj))) + +(defun section-tree () + "Return result of `rst-section-tree' with markers replaced by integers." + (mrk2int (rst-section-tree))) + +(defun section-tree-point () + "Return result of `rst-section-tree-point' with markers replaced by integers." + (mrk2int (rst-section-tree-point (rst-section-tree)))) + +(ert-deftest rst-section-tree () + "Tests `rst-section-tree'." + (let ((title "===== +Title +===== + +") + (headers "Header A +======== + +Header B +======== + +Subheader B.a +------------- + +SubSubheader B.a.1 +~~~~~~~~~~~~~~~~~~ + +Subheader B.b +------------- + +Header C +========")) + (should (ert-equal-buffer-return + (section-tree) + "" + t + '((nil)) + )) + (should (ert-equal-buffer-return + (section-tree) + title + t + '((nil 7) (("Title" 7))) + )) + (should (ert-equal-buffer-return + (section-tree) + (concat title headers) + t + '((nil 7) + (("Title" 7) + (("Header A" 20)) + (("Header B" 39) + (("Subheader B.a" 58) + (("SubSubheader B.a.1" 87))) + (("Subheader B.b" 126))) + (("Header C" 155)))) + )) + )) + +(ert-deftest rst-section-tree-point () + "Tests `rst-section-tree-point'." + (let ((title "===== +Title +===== + +")) + (should (ert-equal-buffer-return + (section-tree-point) + "\^@" + t + '(((nil))) + )) + (should (ert-equal-buffer-return + (section-tree-point) + (concat "\^@" title) + t + '(((nil 7))) + )) + (should (ert-equal-buffer-return + (section-tree-point) + (concat title "\^@") + t + '(((nil 7) ("Title" 7)) ("Title" 7)) + )) + (should (ert-equal-buffer-return + (section-tree-point) + (concat title "\^@Header A +======== + +Header B +======== + +Subheader B.a +------------- + +SubSubheader B.a.1 +~~~~~~~~~~~~~~~~~~ + +Subheader B.b +------------- + +Header C +========") + t + '(((nil 7) ("Title" 7) ("Header A" 20)) ("Header A" 20)) + )) + (should (ert-equal-buffer-return + (section-tree-point) + (concat title "Header A +======== + +Header B +======== +\^@ +Subheader B.a +------------- + +SubSubheader B.a.1 +~~~~~~~~~~~~~~~~~~ + +Subheader B.b +------------- + +Header C +========") + t + '(((nil 7) ("Title" 7) ("Header B" 39)) ("Header B" 39) + (("Subheader B.a" 58) + (("SubSubheader B.a.1" 87))) + (("Subheader B.b" 126))) + )) + (should (ert-equal-buffer-return + (section-tree-point) + (concat title "Header A +======== + +Header B +======== + +Subheader B.a\^@ +------------- + +SubSubheader B.a.1 +~~~~~~~~~~~~~~~~~~ + +Subheader B.b +------------- + +Header C +========") + t + '(((nil 7) ("Title" 7) ("Header B" 39) ("Subheader B.a" 58)) + ("Subheader B.a" 58) + (("SubSubheader B.a.1" 87))) + )) + (should (ert-equal-buffer-return + (section-tree-point) + (concat title "Header A +======== + +Header B +======== + +Subheader B.a +------------- + +SubSubheader B.a.1 +~~~~~~~~~~~~~~~~~~ + +S\^@ubheader B.b +------------- + +Header C +========") + t + '(((nil 7) ("Title" 7) ("Header B" 39) ("Subheader B.b" 126)) + ("Subheader B.b" 126)) + )) + )) -- 2.11.4.GIT