;;; 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'.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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.301 2012-07-30 19:29:46 stefan Exp $")
+ "$CVSHeader: sm/rst_el/rst.el,v 1.309.2.1 2012-09-17 17:30:49 stefan Exp $")
(defconst rst-cvs-rev
(rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+"
" .*" rst-cvs-header "0.0")
(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
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)
(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.
(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.
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 ()
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
`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.
(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.
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
: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.
(setq node (cons nil (cdaar children))))
;; Return this node with its children.
- (cons node children)
- ))
+ (cons node children)))
(defun rst-section-tree-point (node &optional point)
(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)
- ))
+ (setq outtree node)))))
+ (cons (cons (car node) path) outtree)))
(defgroup rst-toc nil
"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.
- 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
(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.
(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.
;; 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))
(if (cdr node)
(setq fmt (format "%%-%dd"
(1+ (floor (log10 (length
- (cdr node))))))))
- ))
+ (cdr node))))))))))
(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 ()
(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
"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
(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")
:group 'rst-faces-defaults
:type '(integer)
:set 'rst-set-level-default)
+(rst-testcover-defcustom)
;; 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.
:group 'rst-faces-defaults
:type '(string)
:set 'rst-set-level-default)
+(rst-testcover-defcustom)
;; 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'.
:group 'rst-faces-defaults
:type '(integer)
:set 'rst-set-level-default)
+(rst-testcover-defcustom)
(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)
+(rst-testcover-defcustom)
;; 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'.
:group 'rst-faces-defaults
:type '(integer)
:set 'rst-set-level-default)
+(rst-testcover-defcustom)
(defcustom rst-adornment-faces-alist
;; FIXME LEVEL-FACE: Must be redone if `rst-level-face-max' is changed
(const :tag "section title adornment" nil))
:value-type (face))
:set-after '(rst-level-face-max))
+(rst-testcover-defcustom)
(defun rst-define-level-faces ()
"Define the faces for the section title text faces from the values."
;; 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)
(string :tag "Options"))))
:group 'rst
: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)
;; 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."
(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
projects / emacs.git / commitdiff