From: <sm...@us...> - 2012-04-29 14:50:32
|
Revision: 7398 http://docutils.svn.sourceforge.net/docutils/?rev=7398&view=rev Author: smerten Date: 2012-04-29 14:50:25 +0000 (Sun, 29 Apr 2012) Log Message: ----------- User visible changes: * Symbols follow reStructuredText syntax more closely This implies that role and directive names with internal underscores, plus signs and colons are handled correctly. This is particularly important for Sphinx users where embedded colons are used frequently for this purpose. * `rst-compile-toolsets` is now customizable In addition the default value first looks for a `rst2*.py` and uses it if found or uses the `rst2*` command. Thanks to Emacs developers for this. * Use faces not variables for font-lock customization There are now customizable `rst-*` faces which are used. The old `rst-*-face` variables are still there but deprecated. Thanks to Emacs developers for this. * Font-locking revised again slightly Other changes: * Merge with the changes made in Emacs main line up to bazaar revision 106782 * Minor cleanup Revision Links: -------------- http://docutils.svn.sourceforge.net/docutils/?rev=106782&view=rev Modified Paths: -------------- trunk/docutils/tools/editors/emacs/IDEAS.rst trunk/docutils/tools/editors/emacs/rst.el trunk/docutils/tools/editors/emacs/tests/font-lock.el trunk/docutils/tools/editors/emacs/tests/re.el Modified: trunk/docutils/tools/editors/emacs/IDEAS.rst =================================================================== --- trunk/docutils/tools/editors/emacs/IDEAS.rst 2012-04-29 13:53:38 UTC (rev 7397) +++ trunk/docutils/tools/editors/emacs/IDEAS.rst 2012-04-29 14:50:25 UTC (rev 7398) @@ -322,3 +322,14 @@ add a local mode variable at the top of the file. We could perform this guessing by searching for a valid adornment at the top of the document or searching for reStructuredText directives further on. + +Entry level for rst-straighten-adornments +----------------------------------------- + +* `rst-straighten-adornments` should have an entry level to start at a + lower than the top level + + * I for one prefer a verbose style for top level titles which is not + appropriate for documents without titles + + * Should be done by a prefix argument Modified: trunk/docutils/tools/editors/emacs/rst.el =================================================================== --- trunk/docutils/tools/editors/emacs/rst.el 2012-04-29 13:53:38 UTC (rev 7397) +++ trunk/docutils/tools/editors/emacs/rst.el 2012-04-29 14:50:25 UTC (rev 7398) @@ -1,7 +1,6 @@ ;;; rst.el --- Mode for viewing and editing reStructuredText-documents. -;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 -;; Free Software Foundation, Inc. +;; Copyright (C) 2003-2012 Free Software Foundation, Inc. ;; Maintainer: Stefan Merten <sm...@oe...> ;; Author: Martin Blais <bl...@fu...>, @@ -120,7 +119,7 @@ ;; 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.233 2011-03-20 17:20:28 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.254 2012-04-29 14:49:50 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -145,11 +144,11 @@ ;; Maintained by the release process (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.1.0 %") + "%OfficialVersion: 1.2.0 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%Revision: 1.233 %") + "%Revision: 1.254 %") "CVS revision of this file in the official version.") (defconst rst-version @@ -357,8 +356,7 @@ ; tag ;; Symbol (`sym') - (sym-prt (:alt "\\sw" "\\s_")) - (sym-tag sym-prt "+") + (sym-tag (:shy "\\sw+" (:shy "\\s_\\sw+") "*")) ;; URIs (`uri') (uri-tag (:alt ,@rst-uri-schemes)) @@ -422,6 +420,7 @@ Each entry consists of the symbol naming the regex and an argument list for `rst-re'.") +;; FIXME: Use `sregex` or `rx` instead of re-inventing the wheel (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: @@ -548,7 +547,7 @@ (rst-define-key map [?\C-c ?\C-a ?\C-h] 'describe-prefix-bindings) ;; 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) - ;; Homogeneize the adornments in the document. + ;; Homogenize the adornments in the document. (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-adornments [?\C-c ?\C-s]) @@ -664,21 +663,22 @@ (modify-syntax-entry ?& "." st) (modify-syntax-entry ?' "." st) (modify-syntax-entry ?* "." st) - (modify-syntax-entry ?+ "." st) + (modify-syntax-entry ?+ "_" st) (modify-syntax-entry ?. "_" st) (modify-syntax-entry ?/ "." st) + (modify-syntax-entry ?: "_" st) (modify-syntax-entry ?< "." st) (modify-syntax-entry ?= "." st) (modify-syntax-entry ?> "." st) (modify-syntax-entry ?\\ "\\" st) (modify-syntax-entry ?| "." st) - (modify-syntax-entry ?_ "." st) - (modify-syntax-entry (aref "\u00ab" 0) "." st) - (modify-syntax-entry (aref "\u00bb" 0) "." st) - (modify-syntax-entry (aref "\u2018" 0) "." st) - (modify-syntax-entry (aref "\u2019" 0) "." st) - (modify-syntax-entry (aref "\u201c" 0) "." st) - (modify-syntax-entry (aref "\u201d" 0) "." st) + (modify-syntax-entry ?_ "_" st) + (modify-syntax-entry ?\u00ab "." st) + (modify-syntax-entry ?\u00bb "." st) + (modify-syntax-entry ?\u2018 "." st) + (modify-syntax-entry ?\u2019 "." st) + (modify-syntax-entry ?\u201c "." st) + (modify-syntax-entry ?\u201d "." st) st) "Syntax table used while in `rst-mode'.") @@ -769,11 +769,10 @@ ;;;###autoload (define-minor-mode rst-minor-mode - "ReST Minor Mode. -Toggle ReST minor mode. -With no argument, this command toggles the mode. -Non-null prefix argument turns on the mode. -Null prefix argument turns off the mode. + "Toggle ReST minor mode. +With a prefix argument ARG, enable ReST minor mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. When ReST minor mode is enabled, the ReST mode keybindings are installed on top of the major mode bindings. Use this @@ -985,12 +984,10 @@ If there are existing overline and/or underline from the existing adornment, they are removed before adding the requested adornment." - (let (marker + (end-of-line) + (let ((marker (point-marker)) len) - (end-of-line) - (setq marker (point-marker)) - ;; Fixup whitespace at the beginning and end of the line (if (or (null indent) (eq style 'simple)) (setq indent 0)) @@ -1102,9 +1099,9 @@ (cond ((and nxt-emp prv-emp) ;; A transition - (setq key t) - (setq beg-txt beg-pnt) - (setq end-txt end-pnt)) + (setq key t + beg-txt beg-pnt + end-txt end-pnt)) ((or und-fnd ovr-fnd) ;; An overline with an underline (setq key (cons ado-ch 'over-and-under)) @@ -1113,22 +1110,22 @@ (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt)) (txt-pnt (if ovr-fnd ttl-abv ttl-blw))) (goto-char ovr-pnt) - (setq beg-ovr (point)) - (setq end-ovr (line-end-position)) + (setq beg-ovr (point) + end-ovr (line-end-position)) (goto-char txt-pnt) - (setq beg-txt (point)) - (setq end-txt (line-end-position)) + (setq beg-txt (point) + end-txt (line-end-position)) (goto-char und-pnt) - (setq beg-und (point)) - (setq end-und (line-end-position)))) + (setq beg-und (point) + end-und (line-end-position)))) (ttl-abv ;; An underline - (setq key (cons ado-ch 'simple)) - (setq beg-und beg-pnt) - (setq end-und end-pnt) + (setq key (cons ado-ch 'simple) + beg-und beg-pnt + end-und end-pnt) (goto-char ttl-abv) - (setq beg-txt (point)) - (setq end-txt (line-end-position))) + (setq beg-txt (point) + end-txt (line-end-position))) (t ;; Invalid adornment (setq key nil))) @@ -1203,8 +1200,8 @@ (defun rst-reset-section-caches () "Reset all section cache variables. Should be called by interactive functions which deal with sections." - (setq rst-all-sections nil) - (setq rst-section-hierarchy nil)) + (setq rst-all-sections nil + rst-section-hierarchy nil)) (defvar rst-all-sections nil "All section adornments in the buffer as found by `rst-find-all-adornments'. @@ -1284,10 +1281,11 @@ (if (eq rst-section-hierarchy t) nil rst-section-hierarchy) - (let ((all (rst-find-all-adornments)) - r) - (setq all (assq-delete-all ignore all)) - (setq r (rst-infer-hierarchy (mapcar 'cdr all))) + (let ((r (rst-infer-hierarchy + (mapcar 'cdr + (assq-delete-all + ignore + (rst-find-all-adornments)))))) (setq rst-section-hierarchy (if ignore ;; Clear cache reflecting that a possible update is not @@ -1410,7 +1408,7 @@ (interactive "P") (let* (;; Save our original position on the current line. - (origpt (set-marker (make-marker) (point))) + (origpt (point-marker)) (reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0))) (toggle-style (and pfxarg (not reverse-direction)))) @@ -1709,32 +1707,28 @@ ;; Create a list of markers for all the adornments which are found within ;; the region. (save-excursion - (let (m line) + (let (line) (while (and cur (< (setq line (caar cur)) region-end-line)) - (setq m (make-marker)) (goto-char (point-min)) (forward-line (1- line)) - (push (list (set-marker m (point)) (cdar cur)) marker-list) + (push (list (point-marker) (cdar cur)) marker-list) (setq cur (cdr cur)) )) ;; Apply modifications. - (let (nextado) - (dolist (p marker-list) - ;; Go to the adornment to promote. - (goto-char (car p)) + (dolist (p marker-list) + ;; Go to the adornment to promote. + (goto-char (car p)) - ;; Rotate the next adornment. - (setq nextado (rst-get-next-adornment - (cadr p) hier suggestion demote)) + ;; Update the adornment. + (apply 'rst-update-section + ;; Rotate the next adornment. + (rst-get-next-adornment + (cadr p) hier suggestion demote)) - ;; Update the adornment. - (apply 'rst-update-section nextado) - - ;; Clear marker to avoid slowing down the editing after we're done. - (set-marker (car p) nil) - )) + ;; Clear marker to avoid slowing down the editing after we're done. + (set-marker (car p) nil)) (setq deactivate-mark nil) - ))) + ))) @@ -1776,11 +1770,10 @@ (lambda (ado) (cons (rst-position (cdr ado) (rst-get-hierarchy)) - (let ((m (make-marker))) + (progn (goto-char (point-min)) (forward-line (1- (car ado))) - (set-marker m (point)) - m))) + (point-marker)))) (rst-find-all-adornments)))) (dolist (lm levels-and-markers) ;; Go to the appropriate position @@ -1857,7 +1850,7 @@ a regular expression for matching the lines after indentation with items. Returns a list of cons cells consisting of the point and the column of the point." - (let (pfx) + (let ((pfx ())) (save-excursion (goto-char beg) (while (< (point) end) @@ -2132,10 +2125,9 @@ (forward-line (1- (car ado))) (list (gethash (cons (cadr ado) (caddr ado)) levels) (rst-get-stripped-line) - (let ((m (make-marker))) + (progn (beginning-of-line 1) - (set-marker m (point))) - )) + (point-marker)))) (rst-find-all-adornments)))) (let ((lcontnr (cons nil lines))) (rst-section-tree-rec lcontnr -1)))) @@ -2282,7 +2274,7 @@ (delete-region init-point (+ init-point (length initial-indent))) ;; Delete the last newline added. - (delete-backward-char 1) + (delete-char -1) ))) (defun rst-toc-insert-node (node level indent pfx) @@ -2461,7 +2453,7 @@ (defvar rst-toc-buffer-name "*Table of Contents*" "Name of the Table of Contents buffer.") -(defvar rst-toc-return-buffer nil +(defvar rst-toc-return-wincfg nil "Window configuration to which to return when leaving the TOC.") @@ -2503,7 +2495,7 @@ (pop-to-buffer buf) ;; Save the buffer to return to. - (set (make-local-variable 'rst-toc-return-buffer) curbuf) + (set (make-local-variable 'rst-toc-return-wincfg) curbuf) ;; Move the cursor near the right section in the TOC. (goto-char (point-min)) @@ -2528,7 +2520,7 @@ (interactive) (let ((pos (rst-toc-mode-find-section))) (when kill - (set-window-configuration (car rst-toc-return-buffer)) + (set-window-configuration (car rst-toc-return-wincfg)) (kill-buffer (get-buffer rst-toc-buffer-name))) (pop-to-buffer (marker-buffer pos)) (goto-char pos) @@ -2544,11 +2536,11 @@ "In `rst-toc' mode, go to the occurrence whose line you click on. EVENT is the input event." (interactive "e") - (let (pos) - (with-current-buffer (window-buffer (posn-window (event-end event))) - (save-excursion - (goto-char (posn-point (event-end event))) - (setq pos (rst-toc-mode-find-section)))) + (let ((pos + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion + (goto-char (posn-point (event-end event))) + (rst-toc-mode-find-section))))) (pop-to-buffer (marker-buffer pos)) (goto-char pos) (recenter 5))) @@ -2562,7 +2554,7 @@ (defun rst-toc-quit-window () "Leave the current TOC buffer." (interactive) - (let ((retbuf rst-toc-return-buffer)) + (let ((retbuf rst-toc-return-wincfg)) (set-window-configuration (car retbuf)) (goto-char (cadr retbuf)))) @@ -2689,8 +2681,7 @@ of each paragraph only." `(save-excursion (let ((leftcol (rst-find-leftmost-column ,beg ,end)) - (endm (set-marker (make-marker) ,end)) - ) + (endm (copy-marker ,end))) (do* (;; Iterate lines (l (progn (goto-char ,beg) (back-to-indentation)) @@ -2727,8 +2718,7 @@ `(save-excursion (let ((,leftmost (rst-find-leftmost-column ,beg ,end)) - (endm (set-marker (make-marker) ,end)) - ) + (endm (copy-marker ,end))) (do* (;; Iterate lines (l (progn (goto-char ,beg) (back-to-indentation)) @@ -3059,7 +3049,7 @@ ;;------------------------------------------------------------------------------ ;; FIXME: these next functions should become part of a larger effort to redo the -;; bullets in bulletted lists. The enumerate would just be one of the possible +;; bullets in bulleted lists. The enumerate would just be one of the possible ;; outputs. ;; ;; FIXME: We need to do the enumeration removal as well. @@ -3100,9 +3090,7 @@ (let* (;; Find items and convert the positions to markers. (items (mapcar (lambda (x) - (cons (let ((m (make-marker))) - (set-marker m (car x)) - m) + (cons (copy-marker (car x)) (cdr x))) (rst-find-pfx-in-region beg end (rst-re 'itmany-sta-1)))) (count 1) @@ -3144,67 +3132,139 @@ (require 'font-lock) +;; FIXME: The obsolete variables need to disappear + (defgroup rst-faces nil "Faces used in Rst Mode." :group 'rst :group 'faces :version "21.1") -(defcustom rst-block-face 'font-lock-keyword-face +(defface rst-block '((t :inherit font-lock-keyword-face)) + "Face used for all syntax marking up a special block." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-block-face 'rst-block "All syntax marking up a special block." + :version "24.1" :group 'rst-faces :type '(face)) +(make-obsolete-variable 'rst-block-face + "customize the face `rst-block' instead." + "24.1") -(defcustom rst-external-face 'font-lock-type-face +(defface rst-external '((t :inherit font-lock-type-face)) + "Face used for field names and interpreted text." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-external-face 'rst-external "Field names and interpreted text." + :version "24.1" :group 'rst-faces :type '(face)) +(make-obsolete-variable 'rst-external-face + "customize the face `rst-external' instead." + "24.1") -(defcustom rst-definition-face 'font-lock-function-name-face +(defface rst-definition '((t :inherit font-lock-function-name-face)) + "Face used for all other defining constructs." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-definition-face 'rst-definition "All other defining constructs." + :version "24.1" :group 'rst-faces :type '(face)) +(make-obsolete-variable 'rst-definition-face + "customize the face `rst-definition' instead." + "24.1") -(defcustom rst-directive-face - ;; XEmacs compatibility - (if (boundp 'font-lock-builtin-face) - 'font-lock-builtin-face - 'font-lock-preprocessor-face) +;; XEmacs compatibility (?). +(defface rst-directive (if (boundp 'font-lock-builtin-face) + '((t :inherit font-lock-builtin-face)) + '((t :inherit font-lock-preprocessor-face))) + "Face used for directives and roles." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-directive-face 'rst-directive "Directives and roles." :group 'rst-faces :type '(face)) +(make-obsolete-variable 'rst-directive-face + "customize the face `rst-directive' instead." + "24.1") -(defcustom rst-comment-face 'font-lock-comment-face +(defface rst-comment '((t :inherit font-lock-comment-face)) + "Face used for comments." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-comment-face 'rst-comment "Comments." + :version "24.1" :group 'rst-faces :type '(face)) +(make-obsolete-variable 'rst-comment-face + "customize the face `rst-comment' instead." + "24.1") -(defcustom rst-emphasis1-face - ;; XEmacs compatibility - (if (facep 'italic) - ''italic - 'italic) +(defface rst-emphasis1 '((t :inherit italic)) + "Face used for simple emphasis." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-emphasis1-face 'rst-emphasis1 "Simple emphasis." + :version "24.1" :group 'rst-faces :type '(face)) +(make-obsolete-variable 'rst-emphasis1-face + "customize the face `rst-emphasis1' instead." + "24.1") -(defcustom rst-emphasis2-face - ;; XEmacs compatibility - (if (facep 'bold) - ''bold - 'bold) +(defface rst-emphasis2 '((t :inherit bold)) + "Face used for double emphasis." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-emphasis2-face 'rst-emphasis2 "Double emphasis." :group 'rst-faces :type '(face)) +(make-obsolete-variable 'rst-emphasis2-face + "customize the face `rst-emphasis2' instead." + "24.1") -(defcustom rst-literal-face 'font-lock-string-face +(defface rst-literal '((t :inherit font-lock-string-face)) + "Face used for literal text." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-literal-face 'rst-literal "Literal text." + :version "24.1" :group 'rst-faces :type '(face)) +(make-obsolete-variable 'rst-literal-face + "customize the face `rst-literal' instead." + "24.1") -(defcustom rst-reference-face 'font-lock-variable-name-face +(defface rst-reference '((t :inherit font-lock-variable-name-face)) + "Face used for references to a definition." + :version "24.1" + :group 'rst-faces) + +(defcustom rst-reference-face 'rst-reference "References to a definition." + :version "24.1" :group 'rst-faces :type '(face)) +(make-obsolete-variable 'rst-reference-face + "customize the face `rst-reference' instead." + "24.1") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3228,7 +3288,7 @@ (rst-define-level-faces))) ;; Faces for displaying items on several levels; these definitions define -;; different shades of grey where the lightest one (i.e. least contrasting) is +;; different shades of gray where the lightest one (i.e. least contrasting) is ;; used for level 1 (defcustom rst-level-face-max 6 "Maximum depth of levels for which section title faces are defined." @@ -3311,10 +3371,11 @@ 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) + (unless (facep sym) + (make-empty-face sym) + (set-face-doc-string sym doc) + (set-face-background sym col) + (set sym sym)) (setq i (1+ i)))))) (rst-define-level-faces) @@ -3331,44 +3392,44 @@ ;; `Bullet Lists`_ ;; FIXME: A bullet directly after a field name is not recognized (,(rst-re 'lin-beg '(:grp bul-sta)) - 1 ,rst-block-face) + 1 rst-block-face) ;; `Enumerated Lists`_ (,(rst-re 'lin-beg '(:grp enmany-sta)) - 1 ,rst-block-face) + 1 rst-block-face) ;; `Definition Lists`_ FIXME: missing ;; `Field Lists`_ (,(rst-re 'lin-beg '(:grp fld-tag) 'bli-sfx) - 1 ,rst-external-face) + 1 rst-external-face) ;; `Option Lists`_ (,(rst-re 'lin-beg '(:grp opt-tag (:shy optsep-tag opt-tag) "*") '(:alt "$" (:seq hws-prt "\\{2\\}"))) - 1 ,rst-block-face) + 1 rst-block-face) ;; `Line Blocks`_ ;; Only for lines containing no more bar - to distinguish from tables (,(rst-re 'lin-beg '(:grp "|" bli-sfx) "[^|\n]*$") - 1 ,rst-block-face) + 1 rst-block-face) ;; `Tables`_ FIXME: missing ;; All the `Explicit Markup Blocks`_ ;; `Footnotes`_ / `Citations`_ (,(rst-re 'lin-beg 'fnc-sta-2) - (1 ,rst-definition-face) - (2 ,rst-definition-face)) + (1 rst-definition-face) + (2 rst-definition-face)) ;; `Directives`_ / `Substitution Definitions`_ (,(rst-re 'lin-beg 'dir-sta-3) - (1 ,rst-directive-face) - (2 ,rst-definition-face) - (3 ,rst-directive-face)) + (1 rst-directive-face) + (2 rst-definition-face) + (3 rst-directive-face)) ;; `Hyperlink Targets`_ (,(rst-re 'lin-beg '(:grp exm-sta "_" (:alt (:seq "`" ilcbkqdef-tag "`") (:seq (:alt "[^:\\\n]" "\\\\.") "+")) ":") 'bli-sfx) - 1 ,rst-definition-face) + 1 rst-definition-face) (,(rst-re 'lin-beg '(:grp "__") 'bli-sfx) - 1 ,rst-definition-face) + 1 rst-definition-face) ;; All `Inline Markup`_ - most of them may be multiline though this is ;; uninteresting @@ -3376,16 +3437,16 @@ ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented ;; `Strong Emphasis`_ (,(rst-re 'ilm-pfx '(:grp "\\*\\*" ilcast-tag "\\*\\*") 'ilm-sfx) - 1 ,rst-emphasis2-face) + 1 rst-emphasis2-face) ;; `Emphasis`_ (,(rst-re 'ilm-pfx '(:grp "\\*" ilcast-tag "\\*") 'ilm-sfx) - 1 ,rst-emphasis1-face) + 1 rst-emphasis1-face) ;; `Inline Literals`_ (,(rst-re 'ilm-pfx '(:grp "``" ilcbkq-tag "``") 'ilm-sfx) - 1 ,rst-literal-face) + 1 rst-literal-face) ;; `Inline Internal Targets`_ (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx) - 1 ,rst-definition-face) + 1 rst-definition-face) ;; `Hyperlink References`_ ;; FIXME: `Embedded URIs`_ not considered ;; FIXME: Directly adjacing marked up words are not fontified correctly @@ -3393,28 +3454,28 @@ (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`") (:seq "\\sw" (:alt "\\sw" "-") "+\\sw")) "__?") 'ilm-sfx) - 1 ,rst-reference-face) + 1 rst-reference-face) ;; `Interpreted Text`_ (,(rst-re 'ilm-pfx '(:grp (:shy ":" sym-tag ":") "?") '(:grp "`" ilcbkq-tag "`") '(:grp (:shy ":" sym-tag ":") "?") 'ilm-sfx) - (1 ,rst-directive-face) - (2 ,rst-external-face) - (3 ,rst-directive-face)) + (1 rst-directive-face) + (2 rst-external-face) + (3 rst-directive-face)) ;; `Footnote References`_ / `Citation References`_ (,(rst-re 'ilm-pfx '(:grp fnc-tag "_") 'ilm-sfx) - 1 ,rst-reference-face) + 1 rst-reference-face) ;; `Substitution References`_ ;; FIXME: References substitutions like |this|_ or |this|__ are not ;; fontified correctly (,(rst-re 'ilm-pfx '(:grp sub-tag) 'ilm-sfx) - 1 ,rst-reference-face) + 1 rst-reference-face) ;; `Standalone Hyperlinks`_ ;; FIXME: This takes it easy by using a whitespace as delimiter (,(rst-re 'ilm-pfx '(:grp uri-tag ":\\S +") 'ilm-sfx) - 1 ,rst-definition-face) + 1 rst-definition-face) (,(rst-re 'ilm-pfx '(:grp sym-tag "@" sym-tag ) 'ilm-sfx) - 1 ,rst-definition-face) + 1 rst-definition-face) ;; Do all block fontification as late as possible so 'append works @@ -3433,20 +3494,24 @@ ;; properties on comments and literal blocks so they are *not* ;; inline fontified; see (elisp)Search-based Fontification + ;; FIXME: And / or use `syntax-propertize` functions as in `octave-mod.el` + ;; and other V24 modes; may make `font-lock-extend-region` + ;; superfluous + ;; `Comments`_ - this is multiline (,(rst-re 'lin-beg 'cmt-sta-1) - (1 ,rst-comment-face) + (1 rst-comment-face) (rst-font-lock-find-unindented-line-match (rst-font-lock-find-unindented-line-limit (match-end 1)) nil - (0 ,rst-comment-face append))) + (0 rst-comment-face append))) (,(rst-re 'lin-beg '(:grp exm-tag) '(:grp hws-tag) "$") - (1 ,rst-comment-face) - (2 ,rst-comment-face) + (1 rst-comment-face) + (2 rst-comment-face) (rst-font-lock-find-unindented-line-match (rst-font-lock-find-unindented-line-limit 'next) nil - (0 ,rst-comment-face append))) + (0 rst-comment-face append))) ;; FIXME: This is not rendered as comment:: ;; .. .. list-table:: @@ -3469,11 +3534,11 @@ ;; `Indented Literal Blocks`_ - this is multiline (,(rst-re 'lin-beg 'lit-sta-2) - (2 ,rst-block-face) + (2 rst-block-face) (rst-font-lock-find-unindented-line-match (rst-font-lock-find-unindented-line-limit t) nil - (0 ,rst-literal-face append))) + (0 rst-literal-face append))) ;; FIXME: `Quoted Literal Blocks`_ missing - this is multiline @@ -3499,8 +3564,8 @@ ;; ;; Indentation is not required for doctest blocks. (,(rst-re 'lin-beg '(:grp (:alt ">>>" ell-tag)) '(:grp ".+")) - (1,rst-block-face) - (2 ,rst-literal-face)) + (1 rst-block-face) + (2 rst-literal-face)) ) "Keywords to highlight in rst mode.") @@ -3516,12 +3581,35 @@ (defun rst-font-lock-extend-region-internal (beg end) "Check the region BEG / END for being in the middle of a multiline construct. Return nil if not or a cons with new values for BEG / END" - ;; There are many potential multiline constructs but really relevant ones are - ;; comment lines without leading explicit markup tag and literal blocks - ;; following "::" which are both indented. Thus indendation is what is - ;; recognized here. The second criteria is an explicit markup tag which may - ;; be a comment or a double colon at the end of a line. - (if (not (get-text-property beg 'font-lock-multiline)) + (let ((nbeg (rst-font-lock-extend-region-extend beg -1)) + (nend (rst-font-lock-extend-region-extend end 1))) + (if (or nbeg nend) + (cons (or nbeg beg) (or nend end))))) + +(defun rst-forward-line (&optional n) + "Like `forward-line' but always end up in column 0 and return accordingly." + (let ((moved (forward-line n))) + (if (bolp) + moved + (forward-line 0) + (- moved (signum n))))) + +(defun rst-font-lock-extend-region-extend (pt dir) + "Extend the region starting at point PT and extending in direction DIR. +Return extended point or nil if not moved." + ;; There are many potential multiline constructs but there are two groups + ;; which are really relevant. The first group consists of + ;; + ;; * comment lines without leading explicit markup tag and + ;; + ;; * literal blocks following "::" + ;; + ;; which are both indented. Thus indendation is the first thing recognized + ;; here. The second criteria is an explicit markup tag which may be a comment + ;; or a double colon at the end of a line. + ;; + ;; The second group consists of the adornment cases. + (if (not (get-text-property pt 'font-lock-multiline)) ;; Move only if we don't start inside a multiline construct already (save-excursion (let (;; non-empty non-indented line, explicit markup tag or literal @@ -3529,13 +3617,36 @@ (stop-re (rst-re '(:alt "[^ \t\n]" (:seq hws-tag exm-tag) (:seq ".*" dcl-tag lin-end))))) - (goto-char beg) + ;; The comments below are for dir == -1 / dir == 1 + (goto-char pt) (forward-line 0) + (setq pt (point)) (while (and (not (looking-at stop-re)) - (zerop (forward-line -1)))) ; try previous line if exists - ;; FIXME: Extending the end should also be done - (if (not (= (point) beg)) - (cons (point) end)))))) + (zerop (rst-forward-line dir)))) ; try previous / next + ; line if it exists + (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline / + ; overline + (if (zerop (rst-forward-line dir)) + (if (looking-at (rst-re 'ttl-beg)) ; title found, i.e. + ; underline / overline + ; found + (if (zerop (rst-forward-line dir)) + (if (not + (looking-at (rst-re 'ado-beg-2-1))) ; no + ; overline / + ; underline + (rst-forward-line (- dir)))) ; step back to title + ; / adornment + (if (< dir 0) ; keep downward adornment + (rst-forward-line (- dir))))) ; step back to adornment + (if (looking-at (rst-re 'ttl-beg)) ; may be a title + (if (zerop (rst-forward-line dir)) + (if (not + (looking-at (rst-re 'ado-beg-2-1))) ; no overline / + ; underline + (rst-forward-line (- dir)))))) ; step back to line + (if (not (= (point) pt)) + (point)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indented blocks @@ -3713,25 +3824,45 @@ :group 'rst :version "21.1") -;; FIXME: Should be `defcustom` -(defvar rst-compile-toolsets - '((html . ("rst2html.py" ".html" nil)) - (latex . ("rst2latex.py" ".tex" nil)) - (newlatex . ("rst2newlatex.py" ".tex" nil)) - (pseudoxml . ("rst2pseudoxml.py" ".xml" nil)) - (xml . ("rst2xml.py" ".xml" nil)) - (pdf . ("rst2pdf.py" ".pdf" nil)) - (s5 . ("rst2s5.py" ".xml" nil))) +(defcustom rst-compile-toolsets + `((html ,(if (executable-find "rst2html.py") "rst2html.py" "rst2html") + ".html" nil) + (latex ,(if (executable-find "rst2latex.py") "rst2latex.py" "rst2latex") + ".tex" nil) + (newlatex ,(if (executable-find "rst2newlatex.py") "rst2newlatex.py" + "rst2newlatex") + ".tex" nil) + (pseudoxml ,(if (executable-find "rst2pseudoxml.py") "rst2pseudoxml.py" + "rst2pseudoxml") + ".xml" nil) + (xml ,(if (executable-find "rst2xml.py") "rst2xml.py" "rst2xml") + ".xml" nil) + (pdf ,(if (executable-find "rst2pdf.py") "rst2pdf.py" "rst2pdf") + ".pdf" nil) + (s5 ,(if (executable-find "rst2s5.py") "rst2s5.py" "rst2s5") + ".html" nil)) "Table describing the command to use for each toolset. An association list of the toolset to a list of the (command to use, extension of produced filename, options to the tool (nil or a -string)) to be used for converting the document.") +string)) to be used for converting the document." + ;; FIXME: These are not options but symbols which may be referenced by + ;; `rst-compile-*-toolset` below + :type '(alist :options (html latex newlatex pseudoxml xml pdf s5) + :key-type symbol + :value-type (list :tag "Specification" + (file :tag "Command") + (string :tag "File extension") + (choice :tag "Command options" + (const :tag "No options" nil) + (string :tag "Options")))) + :group 'rst + :version "24.1") -;; FIXME: Should be `defcustom` +;; FIXME: Must be `defcustom` (defvar rst-compile-primary-toolset 'html "The default toolset for `rst-compile'.") -;; FIXME: Should be `defcustom` +;; FIXME: Must be `defcustom` (defvar rst-compile-secondary-toolset 'latex "The default toolset for `rst-compile' with a prefix argument.") @@ -3935,9 +4066,9 @@ "A portable function that returns non-nil if the mark is active." (cond ((fboundp 'region-active-p) (region-active-p)) - ((boundp 'transient-mark-mode) transient-mark-mode mark-active))) + ((boundp 'transient-mark-mode) (and transient-mark-mode mark-active)) + (t mark-active))) - (provide 'rst) ;;; rst.el ends here Modified: trunk/docutils/tools/editors/emacs/tests/font-lock.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/font-lock.el 2012-04-29 13:53:38 UTC (rev 7397) +++ trunk/docutils/tools/editors/emacs/tests/font-lock.el 2012-04-29 14:50:25 UTC (rev 7398) @@ -31,7 +31,7 @@ (set-mark (cdr r)) t))) -(ert-deftest rst-font-lock-extend-region-internal () +(ert-deftest rst-font-lock-extend-region-internal-indent () "Tests `rst-font-lock-extend-region-internal'." (should (equal-buffer-return '(extend-region) @@ -55,32 +55,52 @@ t)) (should (equal-buffer-return '(extend-region) + " abc +\^@ def +\^? ghi +uvw" + "\^@ abc + def + ghi +\^?uvw" + t + t)) + (should (equal-buffer-return + '(extend-region) "xyz abc -\^@ def\^?" +\^@ def +\^? ghi" "xyz \^@abc - def\^?" + def + ghi\^?" t t)) (should (equal-buffer-return '(extend-region) "xyz abc:: -\^@ def\^?" +\^@ def +\^? ghi +uvw" "xyz \^@ abc:: - def\^?" + def + ghi +\^?uvw" t t)) (should (equal-buffer-return '(extend-region) "xyz .. abc -\^@ def\^?" +\^@ def +\^?uvw" "xyz \^@ .. abc - def\^?" + def +\^?uvw" t t)) (should (equal-buffer-return @@ -88,11 +108,15 @@ "xyz .. abc 123 -\^@ def\^?" +\^@ def +\^? +uvw" "xyz \^@ .. abc 123 - def\^?" + def +\^? +uvw" t t)) (should (equal-buffer-return @@ -103,14 +127,112 @@ 123 -\^@ def\^?" +\^@ def +\^? +uvw" "xyz \^@ .. abc 123 - def\^?" + def +\^? +uvw" t t)) ) + +(ert-deftest rst-font-lock-extend-region-internal-adornment () + "Tests `rst-font-lock-extend-region-internal'." + (should (equal-buffer-return + '(extend-region) + "\^@===\^?" + "\^@===\^?" + nil + t)) + (should (equal-buffer-return + '(extend-region) + "abc +\^@===\^?" + "\^@abc +===\^?" + t + t)) + (should (equal-buffer-return ; Quite complicated without the trailing newline + '(extend-region) + "\^@abc +\^?===" + "\^@abc +\^?===" + nil + t)) + (should (equal-buffer-return + '(extend-region) + "\^@abc +\^?=== +" + "\^@abc +=== +\^?" + t + t)) + (should (equal-buffer-return + '(extend-region) + "=== +abc +\^@=== +\^?" + "\^@=== +abc +=== +\^?" + t + t)) + (should (equal-buffer-return + '(extend-region) + "\^@=== +\^?abc +=== +" + "\^@=== +abc +=== +\^?" + t + t)) + (should (equal-buffer-return + '(extend-region) + "def + +=== +\^@abc +=== +\^?" + "def + +\^@=== +abc +=== +\^?" + t + t)) + (should (equal-buffer-return + '(extend-region) + "def + +\^@=== +abc +\^?=== + +xyz" + "def + +\^@=== +abc +=== +\^? +xyz" + t + t)) + ) Modified: trunk/docutils/tools/editors/emacs/tests/re.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/re.el 2012-04-29 13:53:38 UTC (rev 7397) +++ trunk/docutils/tools/editors/emacs/tests/re.el 2012-04-29 14:50:25 UTC (rev 7398) @@ -633,7 +633,8 @@ (cons "\\\\(|" "\\(?:|") ;; Make a group shy (cons "\\[^|\n]\\+" "\\(?:\\S \\|\\S \\(?:[^|\\\n]\\|\\\\.\\)\\{0,1000\\}[^ |\\]\\)" ) ;; Symbol name more sophisticated - (cons "\\\\(\\\\s" "\\(?:\\s") ;; Make a group shy + (cons (regexp-quote "\\(\\sw\\|\\s_\\)+") + "\\(?:\\sw+\\(?:\\s_\\sw+\\)*\\)") ;; New syntax for symbols (cons "\\\\(\\[\t " "\\(?:[\t ") ;; Make a group shy )) (should (re-equal-matches @@ -760,8 +761,10 @@ (cons "\\\\(\\[^" "\\(?:[^") ;; Make a group shy (cons "\\\\(:" "\\(?::") ;; Make a group shy (cons "\\\\(:" "\\(?::") ;; Make a group shy - (cons "\\\\(\\\\sw" "\\(?:\\sw") ;; Make a group shy - (cons "\\\\(\\\\sw" "\\(?:\\sw") ;; Make a group shy + (cons (regexp-quote "\\(\\sw\\|\\s_\\)+") + "\\(?:\\sw+\\(?:\\s_\\sw+\\)*\\)") ;; New syntax for symbols + (cons (regexp-quote "\\(\\sw\\|\\s_\\)+") + "\\(?:\\sw+\\(?:\\s_\\sw+\\)*\\)") ;; New syntax for symbols (cons (regexp-quote "\\\\]") "\\]") ;; Remove superfluous quote (cons (regexp-quote "\\|$") "") (cons (regexp-quote "\\([\t ]") @@ -819,8 +822,10 @@ (list "someone@example" (cons 2 1)) (cons "^\\\\(" "\\(?:") ;; Make a group shy - (cons "\\\\(\\\\sw" "\\(?:\\sw") ;; Make a group shy - (cons "\\\\(\\\\sw" "\\(?:\\sw") ;; Make a group shy + (cons (regexp-quote "\\(\\sw\\|\\s_\\)+") + "\\(?:\\sw+\\(?:\\s_\\sw+\\)*\\)") ;; New syntax for symbols + (cons (regexp-quote "\\(\\sw\\|\\s_\\)+") + "\\(?:\\sw+\\(?:\\s_\\sw+\\)*\\)") ;; New syntax for symbols (cons (regexp-quote "\\|$") "") (cons (regexp-quote "\\([\t ]") "\\(?:$\\|[\t ]") ;; Move "$" in regex and make a group shy This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <sm...@us...> - 2012-06-16 09:41:49
|
Revision: 7444 http://docutils.svn.sourceforge.net/docutils/?rev=7444&view=rev Author: smerten Date: 2012-06-16 09:41:40 +0000 (Sat, 16 Jun 2012) Log Message: ----------- Major merge with Emacs source tree. Docutils SVN version and Emacs trunk are kept in sync from now on. New version is supposed to appear in Emacs 24.2. User visible changes: * Switch meaning of keybindings ``C-M-a`` and ``C-M-e`` They were wrong in the first place :-( . Sorry for changing bindings again. * Added faces `rst-transition` and `rst-adornment` New faces are used instead of directly using `font-lock-keyword-face`. * Improved customization of `rst-adornment-faces-alist` Hopefully this will not break existing customization. * Character syntax adopted to match plain text again Other code improvements suggested by Emacs developers: * Replaced use of `defun`\s from `cl.el` by own definitions * Improved lots and lots of comments and documentation strings including spelling fixes * Fixed version stuff * Improved some functions * Byte-compiling emits no warnings and works * Added tests Other improvements: * Default for customizing `rst-adornment-faces-alist` is now safe Thanks to Samuel Bronson for the patch. Modified Paths: -------------- trunk/docutils/tools/editors/emacs/IDEAS.rst trunk/docutils/tools/editors/emacs/rst.el trunk/docutils/tools/editors/emacs/tests/Makefile trunk/docutils/tools/editors/emacs/tests/re.el Modified: trunk/docutils/tools/editors/emacs/IDEAS.rst =================================================================== --- trunk/docutils/tools/editors/emacs/IDEAS.rst 2012-06-14 20:39:55 UTC (rev 7443) +++ trunk/docutils/tools/editors/emacs/IDEAS.rst 2012-06-16 09:41:40 UTC (rev 7444) @@ -161,14 +161,36 @@ Outline support =============== -* Support for `outline-mode' / `allout-mode' would be nice +* Support for `outline-mode` / `allout-mode` would be nice * Should consider section titles -* May be folding is also possible + * May be item lists can also be included - * For item lists + * Using `allout-mode` is difficult + * It's not customizable enough for the complex syntax of + reStructuredText + + * However, some commands make sense + + * Motion commands + + * Exposure commands + + * Some alteration commands + + * Should be reimplemented + + * Key bindings need to be reused + + * However, care must be taken if a file uses `allout-mode` for + instance by comment strings + + * In this case key bindings must not be overridden + + * A command adding / updating `allout-mode` tags could be a solution + Sophisticated filling ===================== Modified: trunk/docutils/tools/editors/emacs/rst.el =================================================================== --- trunk/docutils/tools/editors/emacs/rst.el 2012-06-14 20:39:55 UTC (rev 7443) +++ trunk/docutils/tools/editors/emacs/rst.el 2012-06-16 09:41:40 UTC (rev 7444) @@ -3,7 +3,8 @@ ;; Copyright (C) 2003-2012 Free Software Foundation, Inc. ;; Maintainer: Stefan Merten <sm...@oe...> -;; Author: Martin Blais <bl...@fu...>, +;; Author: Stefan Merten <sm...@oe...>, +;; Martin Blais <bl...@fu...>, ;; David Goodger <go...@py...>, ;; Wei-Wei Guo <ww...@gm...> @@ -25,10 +26,10 @@ ;;; Commentary: ;; This package provides major mode rst-mode, which supports documents marked -;; up using the reStructuredText format. Support includes font locking as well -;; as a lot of convenience functions for editing. It does this by defining a -;; Emacs major mode: rst-mode (ReST). This mode is derived from text-mode. This -;; package also contains: +;; up using the reStructuredText format. Support includes font locking as well +;; as a lot of convenience functions for editing. It does this by defining a +;; Emacs major mode: rst-mode (ReST). This mode is derived from text-mode. +;; This package also contains: ;; ;; - Functions to automatically adjust and cycle the section underline ;; adornments; @@ -53,12 +54,12 @@ ;; http://docutils.sourceforge.net/docs/user/emacs.html ;; ;; -;; There are a number of convenient keybindings provided by rst-mode. +;; There are a number of convenient key bindings provided by rst-mode. ;; For more on bindings, see rst-mode-map below. There are also many variables ;; that can be customized, look for defcustom in this file. ;; ;; If you use the table-of-contents feature, you may want to add a hook to -;; update the TOC automatically everytime you adjust a section title:: +;; update the TOC automatically every time you adjust a section title:: ;; ;; (add-hook 'rst-adjust-hook 'rst-toc-update) ;; @@ -70,7 +71,7 @@ ;; ;; ;; Customization is done by customizable variables contained in customization -;; group "rst" and subgroups. Group "rst" is contained in the "wp" group. +;; group "rst" and subgroups. Group "rst" is contained in the "wp" group. ;; ;;; DOWNLOAD @@ -95,21 +96,72 @@ ;; want automatically enter rst-mode from any file with compatible extensions: ;; ;; (setq auto-mode-alist -;; (append '(("\\.txt$" . rst-mode) -;; ("\\.rst$" . rst-mode) -;; ("\\.rest$" . rst-mode)) auto-mode-alist)) +;; (append '(("\\.txt\\'" . rst-mode) +;; ("\\.rst\\'" . rst-mode) +;; ("\\.rest\\'" . rst-mode)) auto-mode-alist)) ;; ;;; Code: -(require 'cl) +;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*- +;; lexical-binding: t -*-" in the first line. +;; Only use of macros is allowed - may be replaced by `cl-lib' some time. +(eval-when-compile + (require 'cl)) + +;; Redefine some functions from `cl.el' in a proper namespace until they may be +;; used from there. + +(defun rst-signum (x) + "Return 1 if X is positive, -1 if negative, 0 if zero." + (cond + ((> x 0) 1) + ((< x 0) -1) + (t 0))) + +(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 +`identity'." + (unless pred + (setq pred 'identity)) + (catch 'rst-some + (dolist (elem seq) + (let ((r (funcall pred elem))) + (when r + (throw 'rst-some r)))))) + +(defun rst-position-if (pred seq) + "Return position of first element satisfying PRED in list SEQ or nil." + (catch 'rst-position-if + (let ((i 0)) + (dolist (elem seq) + (when (funcall pred elem) + (throw 'rst-position-if i)) + (incf i))))) + +(defun rst-position (elem seq) + "Return position of ELEM in list SEQ or nil. +Comparison done with `equal'." + ;; Create a closure containing `elem' so the `lambda' always sees our + ;; parameter instead of an `elem' which may be in dynamic scope at the time + ;; of execution of the `lambda'. + (lexical-let ((elem elem)) + (rst-position-if (function (lambda (e) + (equal elem e))) + seq))) + +;; FIXME: Embed complicated `defconst's in `eval-when-compile'. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Versions (defun rst-extract-version (delim-re head-re re tail-re var &optional default) - "Return the version matching RE after regex DELIM-RE and HEAD-RE -and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match" + "Extract the version from a variable according to the given regexes. +Return the version after regex DELIM-RE and HEAD-RE matching RE +and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." (if (string-match (concat delim-re head-re "\\(" re "\\)" tail-re delim-re) var) @@ -117,20 +169,20 @@ default)) ;; Use CVSHeader to really get information from CVS and not other version -;; control systems +;; control systems. (defconst rst-cvs-header - "$CVSHeader: sm/rst_el/rst.el,v 1.256 2012-04-29 15:00:50 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.286 2012-06-16 09:41:21 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") - "The CVS revision of this file. CVS revision is the development revision.") + "The CVS revision of this file. CVS revision is the development revision.") (defconst rst-cvs-timestamp (rst-extract-version "\\$" "CVSHeader: \\S + \\S + " "[0-9]+-[0-9]+-[0-9]+ [0-9]+:[0-9]+:[0-9]+" " .*" rst-cvs-header "1970-01-01 00:00:00") - "The CVS timestamp of this file.") + "The CVS time stamp of this file.") -;; Use LastChanged... to really get information from SVN +;; Use LastChanged... to really get information from SVN. (defconst rst-svn-rev (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " " "$LastChangedRevision$") @@ -139,16 +191,16 @@ (defconst rst-svn-timestamp (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " " "$LastChangedDate$") - "The SVN timestamp of this file.") + "The SVN time stamp of this file.") -;; Maintained by the release process +;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.2.1 %") + "%OfficialVersion: 1.3.0 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%Revision: 1.256 %") + "$Revision$") "CVS revision of this file in the official version.") (defconst rst-version @@ -157,14 +209,15 @@ (format "%s (development %s [%s])" rst-official-version rst-cvs-rev rst-cvs-timestamp)) "The version string. -Starts with the current official version. For developer versions -in parentheses follows the development revision and the timestamp.") +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.0") - ("1.1.0" . "24.0") - ("1.2.0" . "24.0") - ("1.2.1" . "24.0"))) + '(("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"))) (unless (assoc rst-official-version rst-package-emacs-version-alist) (error "Version %s not listed in `rst-package-emacs-version-alist'" @@ -187,12 +240,12 @@ ;; Facilities for regular expressions used everywhere ;; The trailing numbers in the names give the number of referenceable regex -;; groups contained in the regex +;; groups contained in the regex. ;; Used to be customizable but really is not customizable but fixed by the reST -;; syntax +;; syntax. (defconst rst-bullets - ;; Sorted so they can form a character class when concatenated + ;; Sorted so they can form a character class when concatenated. '(?- ?* ?+ ?\u2022 ?\u2023 ?\u2043) "List of all possible bullet characters for bulleted lists.") @@ -203,7 +256,7 @@ "Supported URI schemes.") (defconst rst-adornment-chars - ;; Sorted so they can form a character class when concatenated + ;; Sorted so they can form a character class when concatenated. '(?\] ?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?+ ?, ?. ?/ ?: ?\; ?< ?= ?> ?? ?@ ?\[ ?\\ ?^ ?_ ?` ?{ ?| ?} ?~ @@ -215,45 +268,45 @@ "Maximum length of inline markup to recognize.") (defconst rst-re-alist-def - ;; `*-beg' matches * at the beginning of a line - ;; `*-end' matches * at the end of a line - ;; `*-prt' matches a part of * - ;; `*-tag' matches * - ;; `*-sta' matches the start of * which may be followed by respective content - ;; `*-pfx' matches the delimiter left of * - ;; `*-sfx' matches the delimiter right of * - ;; `*-hlp' helper for * + ;; `*-beg' matches * at the beginning of a line. + ;; `*-end' matches * at the end of a line. + ;; `*-prt' matches a part of *. + ;; `*-tag' matches *. + ;; `*-sta' matches the start of * which may be followed by respective content. + ;; `*-pfx' matches the delimiter left of *. + ;; `*-sfx' matches the delimiter right of *. + ;; `*-hlp' helper for *. ;; ;; A trailing number says how many referenceable groups are contained. `( ;; Horizontal white space (`hws') (hws-prt "[\t ]") - (hws-tag hws-prt "*") ; Optional sequence of horizontal white space - (hws-sta hws-prt "+") ; Mandatory sequence of horizontal white space + (hws-tag hws-prt "*") ; Optional sequence of horizontal white space. + (hws-sta hws-prt "+") ; Mandatory sequence of horizontal white space. ;; Lines (`lin') - (lin-beg "^" hws-tag) ; Beginning of a possibly indented line - (lin-end hws-tag "$") ; End of a line with optional trailing white space - (linemp-tag "^" hws-tag "$") ; Empty line with optional white space + (lin-beg "^" hws-tag) ; Beginning of a possibly indented line. + (lin-end hws-tag "$") ; End of a line with optional trailing white space. + (linemp-tag "^" hws-tag "$") ; Empty line with optional white space. ;; Various tags and parts (ell-tag "\\.\\.\\.") ; Ellipsis - (bul-tag ,(concat "[" rst-bullets "]")) ; A bullet - (ltr-tag "[a-zA-Z]") ; A letter enumerator tag - (num-prt "[0-9]") ; A number enumerator part - (num-tag num-prt "+") ; A number enumerator tag - (rom-prt "[IVXLCDMivxlcdm]") ; A roman enumerator part - (rom-tag rom-prt "+") ; A roman enumerator tag - (aut-tag "#") ; An automatic enumerator tag - (dcl-tag "::") ; Double colon + (bul-tag ,(concat "[" rst-bullets "]")) ; A bullet. + (ltr-tag "[a-zA-Z]") ; A letter enumerator tag. + (num-prt "[0-9]") ; A number enumerator part. + (num-tag num-prt "+") ; A number enumerator tag. + (rom-prt "[IVXLCDMivxlcdm]") ; A roman enumerator part. + (rom-tag rom-prt "+") ; A roman enumerator tag. + (aut-tag "#") ; An automatic enumerator tag. + (dcl-tag "::") ; Double colon. ;; Block lead in (`bli') (bli-sfx (:alt hws-sta "$")) ; Suffix of a block lead-in with *optional* - ; immediate content + ; immediate content. ;; Various starts - (bul-sta bul-tag bli-sfx) ; Start of a bulleted item + (bul-sta bul-tag bli-sfx) ; Start of a bulleted item. ;; Explicit markup tag (`exm') (exm-tag "\\.\\.") @@ -261,104 +314,105 @@ (exm-beg lin-beg exm-sta) ;; Counters in enumerations (`cnt') - (cntany-tag (:alt ltr-tag num-tag rom-tag aut-tag)) ; An arbitrary counter - (cntexp-tag (:alt ltr-tag num-tag rom-tag)) ; An arbitrary explicit counter + (cntany-tag (:alt ltr-tag num-tag rom-tag aut-tag)) ; An arbitrary counter. + (cntexp-tag (:alt ltr-tag num-tag rom-tag)) ; An arbitrary explicit counter. ;; Enumerator (`enm') (enmany-tag (:alt (:seq cntany-tag "\\.") - (:seq "(?" cntany-tag ")"))) ; An arbitrary enumerator + (:seq "(?" cntany-tag ")"))) ; An arbitrary enumerator. (enmexp-tag (:alt (:seq cntexp-tag "\\.") (:seq "(?" cntexp-tag ")"))) ; An arbitrary explicit - ; enumerator + ; enumerator. (enmaut-tag (:alt (:seq aut-tag "\\.") - (:seq "(?" aut-tag ")"))) ; An automatic enumerator - (enmany-sta enmany-tag bli-sfx) ; An arbitrary enumerator start - (enmexp-sta enmexp-tag bli-sfx) ; An arbitrary explicit enumerator start + (:seq "(?" aut-tag ")"))) ; An automatic enumerator. + (enmany-sta enmany-tag bli-sfx) ; An arbitrary enumerator start. + (enmexp-sta enmexp-tag bli-sfx) ; An arbitrary explicit enumerator start. (enmexp-beg lin-beg enmexp-sta) ; An arbitrary explicit enumerator start - ; at the beginning of a line + ; at the beginning of a line. ;; Items may be enumerated or bulleted (`itm') - (itmany-tag (:alt enmany-tag bul-tag)) ; An arbitrary item tag + (itmany-tag (:alt enmany-tag bul-tag)) ; An arbitrary item tag. (itmany-sta-1 (:grp itmany-tag) bli-sfx) ; An arbitrary item start, group - ; is the item tag + ; is the item tag. (itmany-beg-1 lin-beg itmany-sta-1) ; An arbitrary item start at the ; beginning of a line, group is the - ; item tag + ; item tag. ;; Inline markup (`ilm') (ilm-pfx (:alt "^" hws-prt "[-'\"([{<\u2018\u201c\u00ab\u2019/:]")) (ilm-sfx (:alt "$" hws-prt "[]-'\")}>\u2019\u201d\u00bb/:.,;!?\\]")) ;; Inline markup content (`ilc') - (ilcsgl-tag "\\S ") ; A single non-white character - (ilcast-prt (:alt "[^*\\]" "\\\\.")) ; Part of non-asterisk content - (ilcbkq-prt (:alt "[^`\\]" "\\\\.")) ; Part of non-backquote content + (ilcsgl-tag "\\S ") ; A single non-white character. + (ilcast-prt (:alt "[^*\\]" "\\\\.")) ; Part of non-asterisk content. + (ilcbkq-prt (:alt "[^`\\]" "\\\\.")) ; Part of non-backquote content. (ilcbkqdef-prt (:alt "[^`\\\n]" "\\\\.")) ; Part of non-backquote - ; definition - (ilcbar-prt (:alt "[^|\\]" "\\\\.")) ; Part of non-vertical-bar content + ; definition. + (ilcbar-prt (:alt "[^|\\]" "\\\\.")) ; Part of non-vertical-bar content. (ilcbardef-prt (:alt "[^|\\\n]" "\\\\.")) ; Part of non-vertical-bar - ; definition - (ilcast-sfx "[^\t *\\]") ; Suffix of non-asterisk content - (ilcbkq-sfx "[^\t `\\]") ; Suffix of non-backquote content - (ilcbar-sfx "[^\t |\\]") ; Suffix of non-vertical-bar content - (ilcrep-hlp ,(format "\\{0,%d\\}" rst-max-inline-length)) ; Repeat count + ; definition. + (ilcast-sfx "[^\t *\\]") ; Suffix of non-asterisk content. + (ilcbkq-sfx "[^\t `\\]") ; Suffix of non-backquote content. + (ilcbar-sfx "[^\t |\\]") ; Suffix of non-vertical-bar content. + (ilcrep-hlp ,(format "\\{0,%d\\}" rst-max-inline-length)) ; Repeat count. (ilcast-tag (:alt ilcsgl-tag (:seq ilcsgl-tag ilcast-prt ilcrep-hlp - ilcast-sfx))) ; Non-asterisk content + ilcast-sfx))) ; Non-asterisk content. (ilcbkq-tag (:alt ilcsgl-tag (:seq ilcsgl-tag ilcbkq-prt ilcrep-hlp - ilcbkq-sfx))) ; Non-backquote content + ilcbkq-sfx))) ; Non-backquote content. (ilcbkqdef-tag (:alt ilcsgl-tag (:seq ilcsgl-tag ilcbkqdef-prt ilcrep-hlp - ilcbkq-sfx))) ; Non-backquote definition + ilcbkq-sfx))) ; Non-backquote definition. (ilcbar-tag (:alt ilcsgl-tag (:seq ilcsgl-tag ilcbar-prt ilcrep-hlp - ilcbar-sfx))) ; Non-vertical-bar content + ilcbar-sfx))) ; Non-vertical-bar content. (ilcbardef-tag (:alt ilcsgl-tag (:seq ilcsgl-tag ilcbardef-prt ilcrep-hlp - ilcbar-sfx))) ; Non-vertical-bar definition + ilcbar-sfx))) ; Non-vertical-bar definition. ;; Fields (`fld') - (fldnam-prt (:alt "[^:\n]" "\\\\:")) ; Part of a field name - (fldnam-tag fldnam-prt "+") ; A field name - (fld-tag ":" fldnam-tag ":") ; A field marker + (fldnam-prt (:alt "[^:\n]" "\\\\:")) ; Part of a field name. + (fldnam-tag fldnam-prt "+") ; A field name. + (fld-tag ":" fldnam-tag ":") ; A field marker. ;; Options (`opt') - (optsta-tag (:alt "[-+/]" "--")) ; Start of an option - (optnam-tag "\\sw" (:alt "-" "\\sw") "*") ; Name of an option - (optarg-tag (:shy "[ =]\\S +")) ; Option argument - (optsep-tag (:shy "," hws-prt)) ; Separator between options - (opt-tag (:shy optsta-tag optnam-tag optarg-tag "?")) ; A complete option + (optsta-tag (:alt "[-+/]" "--")) ; Start of an option. + (optnam-tag "\\sw" (:alt "-" "\\sw") "*") ; Name of an option. + (optarg-tag (:shy "[ =]\\S +")) ; Option argument. + (optsep-tag (:shy "," hws-prt)) ; Separator between options. + (opt-tag (:shy optsta-tag optnam-tag optarg-tag "?")) ; A complete option. ;; Footnotes and citations (`fnc') - (fncnam-prt "[^\]\n]") ; Part of a footnote or citation name - (fncnam-tag fncnam-prt "+") ; A footnote or citation name - (fnc-tag "\\[" fncnam-tag "]") ; A complete footnote or citation tag + (fncnam-prt "[^\]\n]") ; Part of a footnote or citation name. + (fncnam-tag fncnam-prt "+") ; A footnote or citation name. + (fnc-tag "\\[" fncnam-tag "]") ; A complete footnote or citation tag. (fncdef-tag-2 (:grp exm-sta) (:grp fnc-tag)) ; A complete footnote or citation definition - ; tag; first group is the explicit markup + ; tag. First group is the explicit markup ; start, second group is the footnote / - ; citation tag + ; citation tag. (fnc-sta-2 fncdef-tag-2 bli-sfx) ; Start of a footnote or citation - ; definition; first group is the explicit + ; definition. First group is the explicit ; markup start, second group is the - ; footnote / citation tag + ; footnote / citation tag. ;; Substitutions (`sub') - (sub-tag "|" ilcbar-tag "|") ; A complete substitution tag + (sub-tag "|" ilcbar-tag "|") ; A complete substitution tag. (subdef-tag "|" ilcbardef-tag "|") ; A complete substitution definition - ; tag + ; tag. ;; Symbol (`sym') - (sym-tag (:shy "\\sw+" (:shy "\\s_\\sw+") "*")) + (sym-prt "[-+.:_]") ; Non-word part of a symbol. + (sym-tag (:shy "\\sw+" (:shy sym-prt "\\sw+") "*")) ;; URIs (`uri') (uri-tag (:alt ,@rst-uri-schemes)) @@ -367,62 +421,64 @@ (ado-prt "[" ,(concat rst-adornment-chars) "]") (adorep3-hlp "\\{3,\\}") ; There must be at least 3 characters because ; otherwise explicit markup start would be - ; recognized + ; recognized. (adorep2-hlp "\\{2,\\}") ; As `adorep3-hlp' but when the first of three - ; characters is matched differently + ; characters is matched differently. (ado-tag-1-1 (:grp ado-prt) "\\1" adorep2-hlp) ; A complete adornment, group is the first ; adornment character and MUST be the FIRST - ; group in the whole expression + ; group in the whole expression. (ado-tag-1-2 (:grp ado-prt) "\\2" adorep2-hlp) ; A complete adornment, group is the first ; adornment character and MUST be the - ; SECOND group in the whole expression + ; SECOND group in the whole expression. (ado-beg-2-1 "^" (:grp ado-tag-1-2) lin-end) ; A complete adornment line; first group is the whole ; adornment and MUST be the FIRST group in the whole ; expression; second group is the first adornment - ; character + ; character. ;; Titles (`ttl') - (ttl-tag "\\S *\\w\\S *") ; A title text - (ttl-beg lin-beg ttl-tag) ; A title text at the beginning of a line + (ttl-tag "\\S *\\w\\S *") ; A title text. + (ttl-beg lin-beg ttl-tag) ; A title text at the beginning of a line. ;; Directives and substitution definitions (`dir') (dir-tag-3 (:grp exm-sta) (:grp (:shy subdef-tag hws-sta) "?") (:grp sym-tag dcl-tag)) ; A directive or substitution definition - ; tag; first group is explicit markup + ; tag. First group is explicit markup ; start, second group is a possibly ; empty substitution tag, third group is ; the directive tag including the double - ; colon + ; colon. (dir-sta-3 dir-tag-3 bli-sfx) ; Start of a directive or substitution - ; definition; groups are as in dir-tag-3 + ; definition. Groups are as in dir-tag-3. ;; Literal block (`lit') (lit-sta-2 (:grp (:alt "[^.\n]" "\\.[^.\n]") ".*") "?" - (:grp dcl-tag) "$") ; Start of a literal block; first group is + (:grp dcl-tag) "$") ; Start of a literal block. First group is ; any text before the double colon tag which ; may not exist, second group is the double - ; colon tag + ; colon tag. ;; Comments (`cmt') (cmt-sta-1 (:grp exm-sta) "[^\[|_\n]" (:alt "[^:\n]" (:seq ":" (:alt "[^:\n]" "$"))) "*$") ; Start of a comment block; first group is explicit markup - ; start + ; start. ;; Paragraphs (`par') (par-tag- (:alt itmany-tag fld-tag opt-tag fncdef-tag-2 dir-tag-3 exm-tag) ) ; Tag at the beginning of a paragraph; there may be groups in - ; certain cases + ; certain cases. ) "Definition alist of relevant regexes. Each entry consists of the symbol naming the regex and an argument list for `rst-re'.") -;; FIXME: Use `sregex` or `rx` instead of re-inventing the wheel +(defvar rst-re-alist) ; Forward declare to use it in `rst-re'. + +;; FIXME: Use `sregex` or `rx` instead of re-inventing the wheel. (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: @@ -433,8 +489,8 @@ A symbol which is resolved to a string using `rst-re-alist-def'. -A list with a keyword in the car. Each element of the cdr of such -a list is recursively interpreted as ARGS. The results of this +A list with a keyword in the car. Each element of the cdr of such +a list is recursively interpreted as ARGS. The results of this interpretation are concatenated according to the keyword. For the keyword `:seq' the results are simply concatenated. @@ -446,11 +502,10 @@ which is shy-grouped (\"\\(?:...\\)\"). For the keyword `:grp' the results are concatenated and form a -referencable grouped (\"\\(...\\)\"). +referenceable group (\"\\(...\\)\"). After interpretation of ARGS the results are concatenated as for -`:seq'. -" +`:seq'." (apply 'concat (mapcar (lambda (re) @@ -459,7 +514,7 @@ re) ((symbolp re) (cadr (assoc re rst-re-alist))) - ((char-valid-p re) + ((characterp re) (regexp-quote (char-to-string re))) ((listp re) (let ((nested @@ -481,109 +536,93 @@ (error "Unknown object type for building regex: %s" re)))) args))) -(defconst rst-re-alist - ;; Shadow global value we are just defining so we can construct it step by - ;; step - (let (rst-re-alist) - (dolist (re rst-re-alist-def) - (setq rst-re-alist - (nconc rst-re-alist - (list (list (car re) (apply 'rst-re (cdr re))))))) - rst-re-alist) - "Alist mapping symbols from `rst-re-alist-def' to regex strings.") +;; FIXME: Remove circular dependency between `rst-re' and `rst-re-alist'. +(with-no-warnings ; Silence byte-compiler about this construction. + (defconst rst-re-alist + ;; Shadow global value we are just defining so we can construct it step by + ;; step. + (let (rst-re-alist) + (dolist (re rst-re-alist-def rst-re-alist) + (setq rst-re-alist + (nconc rst-re-alist + (list (list (car re) (apply 'rst-re (cdr re)))))))) + "Alist mapping symbols from `rst-re-alist-def' to regex strings.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Mode definition. +;; Mode definition -(defvar rst-deprecated-keys nil - "Alist mapping deprecated keys to the new key to use and the definition.") - -(require 'edmacro) - -(defun rst-call-deprecated () - (interactive) - (let* ((dep-key (this-command-keys-vector)) - (dep-key-s (format-kbd-macro dep-key)) - (fnd (assoc dep-key rst-deprecated-keys))) - (if (not fnd) - ;; Exact key sequence not found. Maybe a deprecated key sequence has - ;; been followed by another key. - (let* ((dep-key-pfx (butlast (append dep-key nil) 1)) - (dep-key-def (vconcat dep-key-pfx '(t))) - (fnd-def (assoc dep-key-def rst-deprecated-keys))) - (if (not fnd-def) - (error "Unknown deprecated key sequence %s" dep-key-s) - ;; Don't execute the command in this case - (message "[Deprecated use of key %s; use key %s instead]" - (format-kbd-macro dep-key-pfx) - (format-kbd-macro (second fnd-def))))) - (message "[Deprecated use of key %s; use key %s instead]" - dep-key-s (format-kbd-macro (second fnd))) - (call-interactively (third fnd))))) - (defun rst-define-key (keymap key def &rest deprecated) - "Bind like `define-key' using DEPRECATED as deprecated key definitions. -DEPRECATED key definitions should be in vector notation. These -are defined as well but give an additional message." + "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." (define-key keymap key def) (dolist (dep-key deprecated) - (push (list dep-key key def) rst-deprecated-keys) - (define-key keymap dep-key 'rst-call-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. (defvar rst-mode-map (let ((map (make-sparse-keymap))) - ;; \C-c is the general keymap + ;; \C-c is the general keymap. (rst-define-key map [?\C-c ?\C-h] 'describe-prefix-bindings) ;; - ;; Section Adornments. + ;; Section Adornments ;; ;; 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.) - ;; \C-c \C-a is the keymap for adornments + ;; \C-c \C-a is the keymap for adornments. (rst-define-key map [?\C-c ?\C-a ?\C-h] 'describe-prefix-bindings) - ;; Display the hierarchy of adornments implied by the current document contents. + ;; 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) ;; Homogenize the adornments in the document. (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-adornments [?\C-c ?\C-s]) ;; - ;; Section Movement and Selection. + ;; Section Movement and Selection ;; ;; Mark the subsection where the cursor is. (rst-define-key map [?\C-\M-h] 'rst-mark-section - ;; same as mark-defun sgml-mark-current-element + ;; Same as mark-defun sgml-mark-current-element. [?\C-c ?\C-m]) - ;; Move forward/backward between section titles. - (rst-define-key map [?\C-\M-a] 'rst-forward-section - ;; same as beginning-of-defun + ;; Move backward/forward between section titles. + ;; FIXME: Also bind similar to outline mode. + (rst-define-key map [?\C-\M-a] 'rst-backward-section + ;; Same as beginning-of-defun. [?\C-c ?\C-n]) - (rst-define-key map [?\C-\M-e] 'rst-backward-section - ;; same as end-of-defun + (rst-define-key map [?\C-\M-e] 'rst-forward-section + ;; Same as end-of-defun. [?\C-c ?\C-p]) ;; - ;; Operating on regions. + ;; Operating on regions ;; - ;; \C-c \C-r is the keymap for regions + ;; \C-c \C-r is the keymap for regions. (rst-define-key map [?\C-c ?\C-r ?\C-h] 'describe-prefix-bindings) ;; Makes region a line-block. (rst-define-key map [?\C-c ?\C-r ?\C-l] 'rst-line-block-region [?\C-c ?\C-d]) - ;; Shift region left or right according to tabs + ;; Shift region left or right according to tabs. (rst-define-key map [?\C-c ?\C-r tab] 'rst-shift-region [?\C-c ?\C-r t] [?\C-c ?\C-l t]) ;; - ;; Operating on lists. + ;; Operating on lists ;; - ;; \C-c \C-l is the keymap for lists + ;; \C-c \C-l is the keymap for lists. (rst-define-key map [?\C-c ?\C-l ?\C-h] 'describe-prefix-bindings) ;; Makes paragraphs in region as a bullet list. (rst-define-key map [?\C-c ?\C-l ?\C-b] 'rst-bullet-list-region @@ -597,13 +636,13 @@ ;; Make sure that all the bullets in the region are consistent. (rst-define-key map [?\C-c ?\C-l ?\C-s] 'rst-straighten-bullets-region [?\C-c ?\C-w]) - ;; Insert a list item + ;; Insert a list item. (rst-define-key map [?\C-c ?\C-l ?\C-i] 'rst-insert-list) ;; - ;; Table-of-Contents Features. + ;; Table-of-Contents Features ;; - ;; \C-c \C-t is the keymap for table of contents + ;; \C-c \C-t is the keymap for table of contents. (rst-define-key map [?\C-c ?\C-t ?\C-h] 'describe-prefix-bindings) ;; Enter a TOC buffer to view and move to a specific section. (rst-define-key map [?\C-c ?\C-t ?\C-t] 'rst-toc) @@ -613,14 +652,14 @@ ;; Update the document's TOC (without changing the cursor position). (rst-define-key map [?\C-c ?\C-t ?\C-u] 'rst-toc-update [?\C-c ?\C-u]) - ;; Got to the section under the cursor (cursor must be in TOC). + ;; Go to the section under the cursor (cursor must be in TOC). (rst-define-key map [?\C-c ?\C-t ?\C-j] 'rst-goto-section [?\C-c ?\C-f]) ;; - ;; Converting Documents from Emacs. + ;; Converting Documents from Emacs ;; - ;; \C-c \C-c is the keymap for compilation + ;; \C-c \C-c is the keymap for compilation. (rst-define-key map [?\C-c ?\C-c ?\C-h] 'describe-prefix-bindings) ;; Run one of two pre-configured toolset commands on the document. (rst-define-key map [?\C-c ?\C-c ?\C-c] 'rst-compile @@ -643,8 +682,6 @@ ;; Abbrevs. -(defvar rst-mode-abbrev-table nil - "Abbrev table used while in `rst-mode'.") (define-abbrev-table 'rst-mode-abbrev-table (mapcar (lambda (x) (append x '(nil 0 system))) '(("contents" ".. contents::\n..\n ") @@ -653,28 +690,27 @@ ("skip" "\n\n[...]\n\n ") ("seq" "\n\n[...]\n\n ") ;; FIXME: Add footnotes, links, and more. - ))) + )) + "Abbrev table used while in `rst-mode'.") ;; Syntax table. (defvar rst-mode-syntax-table (let ((st (copy-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?$ "." st) (modify-syntax-entry ?% "." st) (modify-syntax-entry ?& "." st) (modify-syntax-entry ?' "." st) (modify-syntax-entry ?* "." st) - (modify-syntax-entry ?+ "_" st) - (modify-syntax-entry ?. "_" st) + (modify-syntax-entry ?+ "." st) + (modify-syntax-entry ?- "." st) (modify-syntax-entry ?/ "." st) - (modify-syntax-entry ?: "_" st) (modify-syntax-entry ?< "." st) (modify-syntax-entry ?= "." st) (modify-syntax-entry ?> "." st) (modify-syntax-entry ?\\ "\\" st) + (modify-syntax-entry ?_ "." st) (modify-syntax-entry ?| "." st) - (modify-syntax-entry ?_ "_" st) (modify-syntax-entry ?\u00ab "." st) (modify-syntax-entry ?\u00bb "." st) (modify-syntax-entry ?\u2018 "." st) @@ -692,6 +728,8 @@ :group 'rst :type '(hook)) +;; Pull in variable definitions silencing byte-compiler. +(require 'newcomment) ;; 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. @@ -710,7 +748,7 @@ :syntax-table rst-mode-syntax-table :group 'rst - ;; Paragraph recognition + ;; Paragraph recognition. (set (make-local-variable 'paragraph-separate) (rst-re '(:alt "\f" @@ -721,7 +759,7 @@ lin-end (:seq hws-tag par-tag- bli-sfx)))) - ;; Indenting and filling + ;; Indenting and filling. (set (make-local-variable 'indent-line-function) 'rst-indent-line) (set (make-local-variable 'adaptive-fill-mode) t) (set (make-local-variable 'adaptive-fill-regexp) @@ -729,7 +767,7 @@ (set (make-local-variable 'adaptive-fill-function) 'rst-adaptive-fill) (set (make-local-variable 'fill-paragraph-handle-comment) nil) - ;; Comments + ;; Comments. (set (make-local-variable 'comment-start) ".. ") (set (make-local-variable 'comment-start-skip) (rst-re 'lin-beg 'exm-tag 'bli-sfx)) @@ -737,10 +775,12 @@ (set (make-local-variable 'comment-multi-line) t) (set (make-local-variable 'comment-use-syntax) nil) ;; reStructuredText has not really a comment ender but nil is not really a - ;; permissible value + ;; permissible value. (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-end-skip) nil) + ;; Commenting in reStructuredText is very special so use our own set of + ;; functions. (set (make-local-variable 'comment-line-break-function) 'rst-comment-line-break) (set (make-local-variable 'comment-indent-function) @@ -752,21 +792,15 @@ (set (make-local-variable 'uncomment-region-function) 'rst-uncomment-region) - ;; Font lock - (setq font-lock-defaults - '(rst-font-lock-keywords - t nil nil nil - (font-lock-multiline . t) - (font-lock-mark-block-function . mark-paragraph) - ;; rst-mode does not need font-lock-support-mode because it's fast - ;; enough. In fact using `jit-lock-mode` slows things down - ;; considerably even if `rst-font-lock-extend-region` is in place and - ;; compiled. - ;;(font-lock-support-mode . nil) - )) + ;; Font lock. + (set (make-local-variable 'font-lock-defaults) + '(rst-font-lock-keywords + t nil nil nil + (font-lock-multiline . t) + (font-lock-mark-block-function . mark-paragraph))) (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t) - ;; Text after a changed line may need new fontification + ;; Text after a changed line may need new fontification. (set (make-local-variable 'jit-lock-contextually) t)) ;;;###autoload @@ -788,8 +822,8 @@ :group 'rst) ;; FIXME: can I somehow install these too? -;; :abbrev-table rst-mode-abbrev-table -;; :syntax-table rst-mode-syntax-table +;; :abbrev-table rst-mode-abbrev-table +;; :syntax-table rst-mode-syntax-table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -870,7 +904,7 @@ :version "21.1") (define-obsolete-variable-alias - 'rst-preferred-decorations 'rst-preferred-adornments "r6506") + 'rst-preferred-decorations 'rst-preferred-adornments "1.0.0") (defcustom rst-preferred-adornments '((?= over-and-under 1) (?= simple 0) (?- simple 0) @@ -882,10 +916,10 @@ "Preferred hierarchy of section title adornments. 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 +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. This sequence is consulted to offer a new adornment suggestion @@ -990,7 +1024,7 @@ (let ((marker (point-marker)) len) - ;; Fixup whitespace at the beginning and end of the line + ;; Fixup whitespace at the beginning and end of the line. (if (or (null indent) (eq style 'simple)) (setq indent 0)) (beginning-of-line) @@ -1000,10 +1034,10 @@ (end-of-line) (delete-horizontal-space) - ;; Set the current column, we're at the end of the title line + ;; Set the current column, we're at the end of the title line. (setq len (+ (current-column) indent)) - ;; Remove previous line if it is an adornment + ;; Remove previous line if it is an adornment. (save-excursion (forward-line -1) (if (and (looking-at (rst-re 'ado-beg-2-1)) @@ -1012,24 +1046,24 @@ (not (looking-at (rst-re 'ttl-beg))))) (rst-delete-entire-line))) - ;; Remove following line if it is an adornment + ;; Remove following line if it is an adornment. (save-excursion (forward-line +1) (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 - ;; inserting of the underline + ;; inserting of the underline. (if (= (point) (buffer-end 1)) (newline 1))) - ;; Insert overline + ;; Insert overline. (if (eq style 'over-and-under) (save-excursion (beginning-of-line) (open-line 1) (insert (make-string len char)))) - ;; Insert underline + ;; Insert underline. (forward-line +1) (open-line 1) (insert (make-string len char)) @@ -1041,17 +1075,17 @@ (defun rst-classify-adornment (adornment end) "Classify adornment for section titles and transitions. ADORNMENT is the complete adornment string as found in the buffer -with optional trailing whitespace. END is the point after the +with optional trailing whitespace. END is the point after the last character of ADORNMENT. -Return a list. The first entry is t for a transition or a -cons (CHARACTER . STYLE). Check `rst-preferred-adornments' for +Return a list. The first entry is t for a transition or a +cons (CHARACTER . STYLE). Check `rst-preferred-adornments' for the meaning of CHARACTER and STYLE. The remaining list forms four match groups as returned by -`match-data'. Match group 0 matches the whole construct. Match -group 1 matches the overline adornment if present. Match group 2 -matches the section title text or the transition. Match group 3 +`match-data'. Match group 0 matches the whole construct. Match +group 1 matches the overline adornment if present. Match group 2 +matches the section title text or the transition. Match group 3 matches the underline adornment. Return nil if no syntactically valid adornment is found." @@ -1065,33 +1099,33 @@ (beg-pnt (progn (forward-line 0) (point))) - (nxt-emp ; Next line inexistant or empty + (nxt-emp ; Next line nonexistent or empty (save-excursion (or (not (zerop (forward-line 1))) (looking-at (rst-re 'lin-end))))) - (prv-emp ; Previous line inexistant or empty + (prv-emp ; Previous line nonexistent or empty (save-excursion (or (not (zerop (forward-line -1))) (looking-at (rst-re 'lin-end))))) - (ttl-blw ; Title found below starting here + (ttl-blw ; Title found below starting here. (save-excursion (and (zerop (forward-line 1)) (looking-at (rst-re 'ttl-beg)) (point)))) - (ttl-abv ; Title found above starting here + (ttl-abv ; Title found above starting here. (save-excursion (and (zerop (forward-line -1)) (looking-at (rst-re 'ttl-beg)) (point)))) - (und-fnd ; Matching underline found starting here + (und-fnd ; Matching underline found starting here. (save-excursion (and ttl-blw (zerop (forward-line 2)) (looking-at (rst-re ado-re 'lin-end)) (point)))) - (ovr-fnd ; Matching overline found starting here + (ovr-fnd ; Matching overline found starting here. (save-excursion (and ttl-abv (zerop (forward-line -2)) @@ -1100,14 +1134,14 @@ key beg-ovr end-ovr beg-txt end-txt beg-und end-und) (cond ((and nxt-emp prv-emp) - ;; A transition + ;; A transition. (setq key t beg-txt beg-pnt end-txt end-pnt)) ((or und-fnd ovr-fnd) - ;; An overline with an underline + ;; An overline with an underline. (setq key (cons ado-ch 'over-and-under)) - (let (;; Prefer overline match over underline match + (let (;; Prefer overline match over underline match. (und-pnt (if ovr-fnd beg-pnt und-fnd)) (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt)) (txt-pnt (if ovr-fnd ttl-abv ttl-blw))) @@ -1121,7 +1155,7 @@ (setq beg-und (point) end-und (line-end-position)))) (ttl-abv - ;; An underline + ;; An underline. (setq key (cons ado-ch 'simple) beg-und beg-pnt end-und end-pnt) @@ -1129,7 +1163,7 @@ (setq beg-txt (point) end-txt (line-end-position))) (t - ;; Invalid adornment + ;; Invalid adornment. (setq key nil))) (if key (list key @@ -1140,15 +1174,15 @@ (defun rst-find-title-line () "Find a section title line around point and return its characteristics. If the point is on an adornment line find the respective title -line. If the point is on an empty line check previous or next -line whether it is a suitable title line and use it if so. If +line. If the point is on an empty line check previous or next +line whether it is a suitable title line and use it if so. If point is on a suitable title line use it. If no title line is found return nil. -Otherwise return as `rst-classify-adornment' does. However, if +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 +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 @@ -1162,14 +1196,14 @@ (match-end 0)))) (cond ((not r) - ;; Invalid adornment - check whether this is an incomplete overline + ;; Invalid adornment - check whether this is an incomplete overline. (if (and (zerop (forward-line 1)) (looking-at (rst-re 'ttl-beg))) (list (cons char nil) orig-pnt (line-end-position) orig-pnt orig-end (point) (line-end-position) nil nil))) ((consp (car r)) - ;; A section title - not a transition + ;; A section title - not a transition. r)))) ((looking-at (rst-re 'lin-end)) (or @@ -1184,14 +1218,14 @@ (list (cons nil nil) (point) (line-end-position) nil nil (point) (line-end-position) nil nil))))) ((looking-at (rst-re 'ttl-beg)) - ;; Try to use the underline + ;; Try to use the underline. (let ((r (rst-classify-adornment - (buffer-substring-no-properties + (buffer-substring-no-properties (line-beginning-position 2) (line-end-position 2)) (line-end-position 2)))) (if r r - ;; No valid adornment found + ;; No valid adornment found. (list (cons nil nil) (point) (line-end-position) nil nil (point) (line-end-position) nil nil)))))))) @@ -1199,29 +1233,29 @@ ;; current section adornment in a buffer local cache. Thus they can be used for ;; font-locking and manipulation commands. -(defun rst-reset-section-caches () - "Reset all section cache variables. -Should be called by interactive functions which deal with sections." - (setq rst-all-sections nil - rst-section-hierarchy nil)) - (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.") (make-variable-buffer-local 'rst-all-sections) ;; FIXME: If this variable is set to a different value font-locking of section -;; headers is wrong +;; 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 +t when no section adornments were found. Value depends on `rst-all-sections'.") (make-variable-buffer-local 'rst-section-hierarchy) +(defun rst-reset-section-caches () + "Reset all section cache variables. +Should be called by interactive functions which deal with sections." + (setq rst-all-sections nil + rst-section-hierarchy nil)) + (defun rst-find-all-adornments () "Return all the section adornments in the current buffer. Return a list of (LINE . ADORNMENT) with ascending LINE where -LINE is the line containing the section title. ADORNMENT consists +LINE is the line containing the section title. ADORNMENT consists of a (CHARACTER STYLE INDENT) triple as described for `rst-preferred-adornments'. @@ -1235,15 +1269,15 @@ (let ((ado-data (rst-classify-adornment (match-string-no-properties 0) (point)))) (when (and ado-data - (consp (car ado-data))) ; Ignore transitions + (consp (car ado-data))) ; Ignore transitions. (set-match-data (cdr ado-data)) - (goto-char (match-beginning 2)) ; Goto the title start + (goto-char (match-beginning 2)) ; Goto the title start. (push (cons (1+ (count-lines (point-min) (point))) (list (caar ado-data) (cdar ado-data) (current-indentation))) positions) - (goto-char (match-end 0))))) ; Go beyond the whole thing + (goto-char (match-end 0))))) ; Go beyond the whole thing. (setq positions (nreverse positions)) (setq rst-all-sections (or positions t))))) (if (eq rst-all-sections t) @@ -1273,8 +1307,8 @@ "Return the hierarchy of section titles in the file. Return a list of adornments that represents the hierarchy of -section titles in the file. Each element consists of (CHARACTER -STYLE INDENT) as described for `rst-find-all-adornments'. If the +section titles in the file. Each element consists of (CHARACTER +STYLE INDENT) as described for `rst-find-all-adornments'. If the line number in IGNORE is specified, a possibly adornment found on that line is not taken into account when building the hierarchy. @@ -1291,7 +1325,7 @@ (setq rst-section-hierarchy (if ignore ;; Clear cache reflecting that a possible update is not - ;; reflected + ;; reflected. nil (or r t))) r))) @@ -1377,19 +1411,19 @@ ))) -;; FIXME: A line "``/`` full" is not accepted as a section title +;; FIXME: A line "``/`` full" is not accepted as a section title. (defun rst-adjust (pfxarg) "Auto-adjust the adornment around point. -Adjust/rotate the section adornment for the section title -around point or promote/demote the adornments inside the region, +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 -with a positive prefix argument (toggle style), or with a -negative prefix argument (alternate behavior). +with a positive PFXARG (toggle style), or with a negative +PFXARG (alternate behavior). -This function is a bit of a swiss knife. It is meant to adjust -the adornments of a section title in reStructuredText. It tries +This function is a bit of a swiss knife. It is meant to adjust +the adornments of a section title in reStructuredText. It tries to deal with all the possible cases gracefully and to do `the right thing' in all cases. @@ -1402,7 +1436,7 @@ The method can take either (but not both) of a. a (non-negative) prefix argument, which means to toggle the - adornment style. Invoke with a prefix arg for example; + adornment style. Invoke with a prefix argument for example; b. a negative numerical argument, which generally inverts the direction of search in the file or hierarchy. Invoke with C-- @@ -1446,7 +1480,8 @@ (defun rst-adjust-adornment (pfxarg) "Call `rst-adjust-adornment-work' interactively. -Keep this for compatibility for older bindings (are there any?)." +Keep this for compatibility for older bindings (are there any?). +Argument PFXARG has the same meaning as for `rst-adjust'." (interactive "P") (let* ((reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0))) @@ -1660,7 +1695,7 @@ ;; Else, we rotate, ignoring the adornment around the current ;; line... (let* ((hier (rst-get-hierarchy (line-number-at-pos))) - ;; Suggestion, in case we need to come up with something new + ;; Suggestion, in case we need to come up with something new. (suggestion (rst-suggest-new-adornment hier (car (rst-get-adornments-around)))) @@ -1702,7 +1737,7 @@ marker-list ) - ;; Skip the markers that come before the region beginning + ;; Skip the markers that come before the region beginning. (while (and cur (< (caar cur) region-begin-line)) (setq cur (cdr cur))) @@ -1754,11 +1789,6 @@ )) ))) -(defun rst-position (elem list) - "Return position of ELEM in LIST or nil." - (let ((tail (member elem list))) - (if tail (- (length list) (length tail))))) - (defun rst-straighten-adornments () "Redo all the adornments in the current buffer. This is done using our preferred set of adornments. This can be @@ -1767,7 +1797,7 @@ (interactive) (rst-reset-section-caches) (save-excursion - (let (;; Get a list of pairs of (level . marker) + (let (;; Get a list of pairs of (level . marker). (levels-and-markers (mapcar (lambda (ado) (cons (rst-position (cdr ado) @@ -1778,13 +1808,13 @@ (point-marker)))) (rst-find-all-adornments)))) (dolist (lm levels-and-markers) - ;; Go to the appropriate position + ;; Go to the appropriate position. (goto-char (cdr lm)) - ;; Apply the new styule + ;; Apply the new style. (apply 'rst-update-section (nth (car lm) rst-preferred-adornments)) - ;; Reset the market to avoid slowing down editing until it gets GC'ed + ;; Reset the marker to avoid slowing down editing until it gets GC'ed. (set-marker (cdr lm) nil) ) ))) @@ -1797,7 +1827,7 @@ ;================================================= -; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <we...@gm...> +; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <we...@gm...>. ; I needed to make some tiny changes to the functions, so I put it here. ; -- Wei-Wei Guo @@ -1848,9 +1878,9 @@ (defun rst-find-pfx-in-region (beg end pfx-re) "Find all the positions of prefixes in region between BEG and END. -This is used to find bullets and enumerated list items. PFX-RE is +This is used to find bullets and enumerated list items. PFX-RE is a regular expression for matching the lines after indentation -with items. Returns a list of cons cells consisting of the point +with items. Returns a list of cons cells consisting of the point and the column of the point." (let ((pfx ())) (save-excursion @@ -1866,14 +1896,14 @@ (or (looking-at (rst-re 'lin-end)) ; ...empty, (> (current-column) pfx-col) ; ...deeper level, or (and (= (current-column) pfx-col) - (looking-at pfx-re)))))) ; ...pfx at same level + (looking-at pfx-re)))))) ; ...pfx at same level. (push (cons (point) (current-column)) pfx)) (forward-line 1)) ) (nreverse pfx))) (defun rst-insert-list-pos (newitem) - "Arrange relative position of a newly inserted list item. + "Arrange relative position of a newly inserted list item of style NEWITEM. Adding a new list might consider three situations: @@ -1900,6 +1930,7 @@ (end-of-line) (insert "\n\n" newitem " "))) +;; FIXME: Isn't this a `defconst'? (defvar rst-initial-enums (let (vals) (dolist (fmt '("%s." "(%s)" "%s)")) @@ -1908,6 +1939,7 @@ (cons "#." (nreverse vals))) "List of initial enumerations.") +;; 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.") @@ -1916,16 +1948,16 @@ "Insert a new list item. User is asked to select the item style first, for example (a), i), +. Use TAB -for completition and choices. +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 +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 + ;; FIXME: Make this comply to `interactive' standards. (let* ((itemstyle (completing-read "Select preferred item style [#.]: " rst-initial-items nil t nil nil "#.")) @@ -1933,7 +1965,7 @@ (match-string 0 itemstyle))) (no (save-match-data - ;; FIXME: Make this comply to `interactive' standards + ;; FIXME: Make this comply to `interactive' standards. (cond ((equal cnt "a") (let ((itemno (read-string "Give starting value [a]: " @@ -1968,10 +2000,11 @@ :package-version '(rst . "1.1.0")) (defun rst-insert-list-continue (curitem prefer-roman) - "Insert a list item with list start CURITEM including its indentation level." + "Insert a list item with list start CURITEM including its indentation level. +If PREFER-ROMAN roman numbering is preferred over using letters." (end-of-line) (insert - "\n" ; FIXME: Separating lines must be possible + "\n" ; FIXME: Separating lines must be possible. (cond ((string-match (rst-re '(:alt enmaut-tag bul-tag)) curitem) @@ -1982,17 +2015,17 @@ nil nil curitem)) ((and (string-match (rst-re 'rom-tag) curitem) (save-match-data - (if (string-match (rst-re 'ltr-tag) curitem) ; Also a letter tag + (if (string-match (rst-re 'ltr-tag) curitem) ; Also a letter tag. (save-excursion ;; FIXME: Assumes one line list items without separating - ;; empty lines + ;; empty lines. (if (and (zerop (forward-line -1)) (looking-at (rst-re 'enmexp-beg))) (string-match (rst-re 'rom-tag) - (match-string 0)) ; Previous was a roman tag - prefer-roman)) ; Don't know - use flag - t))) ; Not a letter tag + (match-string 0)) ; Previous was a roman tag. + prefer-roman)) ; Don't know - use flag. + t))) ; Not a letter tag. (replace-match (let* ((old (match-string 0 curitem)) (new (save-match-data @@ -2012,14 +2045,14 @@ (defun rst-insert-list (&optional prefer-roman) "Insert a list item at the current point. -The command can insert a new list or a continuing list. When it is called at a -non-list line, it will promote to insert new list. When it is called at a list +The command can insert a new list or a continuing list. When it is called at a +non-list line, it will promote to insert new list. When it is called at a list line, it will insert a list with the same list style. 1. When inserting a new list: -User is asked to select the item style first, for example (a), i), +. Use TAB -for completition and choices. +User is asked to select the item style first, for example (a), i), +. Use TAB +for completion and choices. (a) If user selects bullets or #, it's just added. (b) If user selects enumerations, a further prompt is given. User needs to @@ -2035,7 +2068,7 @@ the problem elegantly in most situations. But when those overlapped list are preceded by a blank line, it is hard to determine which type to use automatically. The function uses alphabetical list by default. If you want -roman numerical list, just use a prefix (\\[universal-argument])." +roman numerical list, just use a prefix to set PREFER-ROMAN." (interactive "P") (beginning-of-line) (if (looking-at (rst-re 'itmany-beg-1)) @@ -2093,8 +2126,8 @@ "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 +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). @@ -2104,7 +2137,7 @@ 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 +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." @@ -2147,14 +2180,14 @@ node children) - ;; If the next adornment matches our level + ;; If the next adornment matches our level. (when (and nado (= (car nado) lev)) - ;; Pop the next adornment and create the current node with it + ;; Pop... [truncated message content] |
From: <sm...@us...> - 2012-07-30 19:29:45
|
Revision: 7490 http://docutils.svn.sourceforge.net/docutils/?rev=7490&view=rev Author: smerten Date: 2012-07-30 19:29:33 +0000 (Mon, 30 Jul 2012) Log Message: ----------- Added C-c C-a C-a to adjust section header adornment. This works with all types of input methods. Fixed bug ID 3551316 (https://sourceforge.net/tracker/index.php?func=detail&aid=3551316&group_id=38414&atid=422030). Modified Paths: -------------- trunk/docutils/tools/editors/emacs/IDEAS.rst trunk/docutils/tools/editors/emacs/rst.el trunk/docutils/tools/editors/emacs/tests/Makefile trunk/docutils/tools/editors/emacs/tests/adjust-section.el trunk/docutils/tools/editors/emacs/tests/adornment.el trunk/docutils/tools/editors/emacs/tests/comment.el trunk/docutils/tools/editors/emacs/tests/fill.el trunk/docutils/tools/editors/emacs/tests/font-lock.el trunk/docutils/tools/editors/emacs/tests/indent.el trunk/docutils/tools/editors/emacs/tests/items.el trunk/docutils/tools/editors/emacs/tests/movement.el trunk/docutils/tools/editors/emacs/tests/re.el trunk/docutils/tools/editors/emacs/tests/shift.el trunk/docutils/tools/editors/emacs/tests/toc.el Added Paths: ----------- trunk/docutils/tools/editors/emacs/tests/buffer.el trunk/docutils/tools/editors/emacs/tests/cl.el trunk/docutils/tools/editors/emacs/tests/ert-buffer.el Removed Paths: ------------- trunk/docutils/tools/editors/emacs/tests/ert-support.el trunk/docutils/tools/editors/emacs/tests/support.el Modified: trunk/docutils/tools/editors/emacs/IDEAS.rst =================================================================== --- trunk/docutils/tools/editors/emacs/IDEAS.rst 2012-07-22 22:08:08 UTC (rev 7489) +++ trunk/docutils/tools/editors/emacs/IDEAS.rst 2012-07-30 19:29:33 UTC (rev 7490) @@ -119,6 +119,10 @@ * If the TOC is displayed in the speedbar this could be used for permanent navigation + * Probably `imenu` functionality can be used for this + + * See `imenu` documentation and `speedbar-use-imenu-flag` + toc-mode without markup ======================= @@ -151,13 +155,23 @@ * If a TOC buffer is created a prefix argument should limit the depth of the listing to the given level -Imenu support -============= +Imenu support or similar +======================== * Imenu could be supported * See `(elisp)Imenu` +* `etags` could be supported + + * See `(emacs)Tags` and `etags.el` + + * May be this can be used for generating HTML local tags somehow? + + * As requested by `Convert to id`_ + + * Could use `complete-tag` + Outline support =============== @@ -334,7 +348,7 @@ corresponding section, to render the toc. Automatic handling of `.txt` files ----------------------------------- +================================== It would be nice to differentiate between text files using reStructuredText and other general text files. If we had a function to @@ -346,7 +360,7 @@ document or searching for reStructuredText directives further on. Entry level for rst-straighten-adornments ------------------------------------------ +========================================= * `rst-straighten-adornments` should have an entry level to start at a lower than the top level @@ -355,3 +369,65 @@ appropriate for documents without titles * Should be done by a prefix argument + +Support for ispell +================== + +* `ispell` may skip certain things + + * Using `ispell-skip-region-alist` + + * ``Code`` should be skipped + + * Literal text after ``::`` should be skipped + + * A customization should switch this on so users are not surprised + +Marriage with `forms-mode` +========================== + +* Like I married `forms-mode` with `sdf-mode` + +* Would allow editing a number of records with a fixed layout + +* The base reStructuredText file should be either + + * a list consisting of field lists + + * The separator needs to be defined, however + + * A section header or transition may be a useful separator + + * a `list-table` + + * a CSV file + + * That would call for a general support for CSV support for forms + + * May be `orgtbl-to-csv` in `org/org-table.el` could be useful for + this + +Marriage with `org-mode` +======================== + +* May be Org mode can be utilized instead of `forms-mode` + + * See `orgtbl-mode` + + * See `orgstruct-mode` + + * Though this looks more like `allout-mode` + +Intelligent quote insertion +=========================== + +* Use or develop something like `insert-pair` + + * Main use for forgotten quoting + + * Thus may rather quote preceding word than following one + + * If `forward-sexp` could be overridden `insert-pair` might me + usable directly + +* Also add something like `delete-pair` Modified: trunk/docutils/tools/editors/emacs/rst.el =================================================================== --- trunk/docutils/tools/editors/emacs/rst.el 2012-07-22 22:08:08 UTC (rev 7489) +++ trunk/docutils/tools/editors/emacs/rst.el 2012-07-30 19:29:33 UTC (rev 7490) @@ -103,6 +103,8 @@ ;;; Code: +;; 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. @@ -123,7 +125,7 @@ (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)) @@ -171,7 +173,7 @@ ;; 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.286 2012-06-16 09:41:21 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.300 2012-07-30 19:24:36 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -196,7 +198,7 @@ ;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.3.0 %") + "%OfficialVersion: 1.3.1 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " @@ -217,7 +219,9 @@ ("1.1.0" . "24.2") ("1.2.0" . "24.2") ("1.2.1" . "24.2") - ("1.3.0" . "24.2"))) + ("1.3.0" . "24.2") + ("1.3.1" . "24.2") + )) (unless (assoc rst-official-version rst-package-emacs-version-alist) (error "Version %s not listed in `rst-package-emacs-version-alist'" @@ -580,10 +584,13 @@ ;; ;; 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) @@ -2847,7 +2854,7 @@ (save-match-data (unless (looking-at (rst-re 'lin-end)) (back-to-indentation) - ;; Current indendation is always the least likely tab. + ;; Current indentation is always the least likely tab. (let ((tabs (list (list (point) 0 nil)))) ; (POINT OFFSET INNER) ;; Push inner tabs more likely to continue writing. (cond @@ -3416,10 +3423,11 @@ (defcustom rst-adornment-faces-alist ;; FIXME LEVEL-FACE: Must be redone if `rst-level-face-max' is changed - (let ((alist (copy-list '((t . rst-transition) - (nil . rst-adornment)))) + (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) @@ -3953,7 +3961,9 @@ 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" Modified: trunk/docutils/tools/editors/emacs/tests/Makefile =================================================================== --- trunk/docutils/tools/editors/emacs/tests/Makefile 2012-07-22 22:08:08 UTC (rev 7489) +++ trunk/docutils/tools/editors/emacs/tests/Makefile 2012-07-30 19:29:33 UTC (rev 7490) @@ -20,6 +20,6 @@ $(EMACS_ERT_PFX) $(addprefix -l ,$(ERT_TESTS)) $(EMACS_ERT_SFX) compile: - $(EMACS_COMPILE_PFX) "$(RST_EL)" $(EMACS_COMPILE_SFX) 2>&1 \ + $(EMACS_COMPILE_PFX) "$(RST_EL)" $(EMACS_COMPILE_SFX) clean: Modified: trunk/docutils/tools/editors/emacs/tests/adjust-section.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/adjust-section.el 2012-07-22 22:08:08 UTC (rev 7489) +++ trunk/docutils/tools/editors/emacs/tests/adjust-section.el 2012-07-30 19:29:33 UTC (rev 7490) @@ -1,8 +1,16 @@ ;; Tests for rst-adjust (add-to-list 'load-path ".") -(load "ert-support" nil t) +(load "ert-buffer" nil t) +(add-to-list 'load-path "..") +(load "rst.el" nil t) +(ert-deftest adjust-section-asserts () + "Check some assertions." + (should (equal ert-Buf-point-char "\^@")) + (should (equal ert-Buf-mark-char "\^?")) + ) + (ert-deftest rst-adjust () "Tests for `rst-adjust'." (let ( ;; Set customizable variables to defined values @@ -16,8 +24,8 @@ (?` simple 0) (?# simple 0) (?@ simple 0)))) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Some Title\^@ @@ -29,8 +37,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Some Title \^@ @@ -42,8 +50,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Some Tit\^@le @@ -55,8 +63,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " \^@Some Title @@ -68,8 +76,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Some Title\^@ @@ -93,8 +101,8 @@ " t)) - (should (equal-buffer - '(rst-adjust 1) + (should (ert-equal-buffer + (rst-adjust 1) " Some Title\^@ @@ -105,8 +113,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Some Title\^@ @@ -118,8 +126,8 @@ " t)) - (should (equal-buffer - '(rst-adjust 1) + (should (ert-equal-buffer + (rst-adjust 1) " Some Title\^@ @@ -130,8 +138,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Previous Title -------------- @@ -148,8 +156,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Previous Title -------------- @@ -172,8 +180,8 @@ " t)) - (should (equal-buffer - '(rst-adjust 1) + (should (ert-equal-buffer + (rst-adjust 1) " Previous Title -------------- @@ -191,8 +199,8 @@ " t)) - (should (equal-buffer - '(rst-adjust 1) + (should (ert-equal-buffer + (rst-adjust 1) " Previous Title -------------- @@ -210,8 +218,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Previous Title -------------- @@ -228,8 +236,8 @@ " t)) - (should (equal-buffer - '(rst-adjust -) + (should (ert-equal-buffer + (rst-adjust -) " Previous Title -------------- @@ -250,8 +258,8 @@ ~~~~~~~~~~ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Previous Title\^@ ---------- @@ -262,8 +270,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Previous Title ----------\^@ @@ -274,8 +282,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Previous Title -\^@ @@ -285,8 +293,8 @@ - " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Previous Title --\^@ @@ -296,8 +304,8 @@ -- " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Previous Title ---\^@ @@ -308,8 +316,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Previous Title ------------------\^@ @@ -320,8 +328,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " ---------------- Previous Title @@ -334,8 +342,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " ----------\^@ Previous Title @@ -348,8 +356,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " ---------- Previous Title\^@ @@ -362,8 +370,8 @@ " t)) - (should (equal-buffer - '(rst-adjust 1) + (should (ert-equal-buffer + (rst-adjust 1) " Previous Title ----------\^@ @@ -375,8 +383,8 @@ " t)) - (should (equal-buffer - '(rst-adjust 1) + (should (ert-equal-buffer + (rst-adjust 1) " ---------------- Previous Title\^@ @@ -388,8 +396,8 @@ " t)) - (should (equal-buffer - '(rst-adjust 1) + (should (ert-equal-buffer + (rst-adjust 1) " --------\^@ Previous Title @@ -401,8 +409,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) "--------\^@ Previous Title ---------------- @@ -413,8 +421,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) "======= Document Title\^@ ============== @@ -425,8 +433,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " ================ Document Title @@ -459,8 +467,8 @@ " t)) - (should (equal-buffer - '(rst-adjust -) + (should (ert-equal-buffer + (rst-adjust -) " ================ Document Title @@ -492,8 +500,8 @@ " t)) - (should (equal-buffer - '(rst-adjust -) + (should (ert-equal-buffer + (rst-adjust -) " ================ Document Title @@ -519,8 +527,8 @@ " t)) - (should (equal-buffer - '(rst-adjust -) + (should (ert-equal-buffer + (rst-adjust -) " ================ Document Title @@ -547,8 +555,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " ================ Document Title @@ -575,8 +583,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " ================ Document Title @@ -601,8 +609,8 @@ " t)) - (should (equal-buffer - '(rst-adjust 1) + (should (ert-equal-buffer + (rst-adjust 1) " SubTitle\^@ ~~~~~~~~ @@ -615,8 +623,8 @@ " t)) - (should (equal-buffer - '(rst-adjust 1) + (should (ert-equal-buffer + (rst-adjust 1) " ~~~~~~~~~~ SubTitle\^@ @@ -629,8 +637,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Document Title\^@ @@ -642,8 +650,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Document Title\^@ @@ -656,8 +664,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Document Title\^@" @@ -668,8 +676,8 @@ ================ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " Document Title ============== @@ -684,8 +692,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) "============== Document Title\^@ ============== @@ -700,8 +708,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " ============== Document Title\^@ @@ -718,8 +726,8 @@ " t)) - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " ============== Document Title @@ -739,8 +747,8 @@ " t)) ;; docutils-Bugs #2972588 - (should (equal-buffer - '(rst-adjust) + (should (ert-equal-buffer + (rst-adjust) " ============== Document Title Modified: trunk/docutils/tools/editors/emacs/tests/adornment.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/adornment.el 2012-07-22 22:08:08 UTC (rev 7489) +++ trunk/docutils/tools/editors/emacs/tests/adornment.el 2012-07-30 19:29:33 UTC (rev 7490) @@ -1,16 +1,24 @@ ;; Tests for various functions handling adornments (add-to-list 'load-path ".") -(load "ert-support" nil t) +(load "ert-buffer" nil t) +(add-to-list 'load-path "..") +(load "rst.el" nil t) +(ert-deftest adornment-asserts () + "Check some assertions." + (should (equal ert-Buf-point-char "\^@")) + (should (equal ert-Buf-mark-char "\^?")) + ) + (defun find-title-line () "Wrapper for calling `rst-find-title-line'." (apply-adornment-match (rst-find-title-line))) (ert-deftest rst-find-title-line () "Tests for `rst-find-title-line'." - (should (equal-buffer-return - '(find-title-line) + (should (ert-equal-buffer-return + (find-title-line) " Du bon vin tous les jours. @@ -23,8 +31,8 @@ " '((nil . nil) nil "Du bon vin tous les jours." nil) )) - (should (equal-buffer-return - '(find-title-line) + (should (ert-equal-buffer-return + (find-title-line) " \^@ Du bon vin tous les jours. @@ -37,8 +45,8 @@ " '((nil . nil) nil "Du bon vin tous les jours." nil) )) - (should (equal-buffer-return - '(find-title-line) + (should (ert-equal-buffer-return + (find-title-line) " Du bon vin tous les jours. @@ -51,8 +59,8 @@ " '((?- . simple) nil "Du bon vin tous les jours." "-----------") )) - (should (equal-buffer-return - '(find-title-line) + (should (ert-equal-buffer-return + (find-title-line) " ------\^@----- Du bon vin tous les jours. @@ -65,8 +73,8 @@ " '((?- . nil) "-----------" "Du bon vin tous les jours." nil) )) - (should (equal-buffer-return - '(find-title-line) + (should (ert-equal-buffer-return + (find-title-line) " \^@----------- Du bon vin tous les jours. @@ -82,8 +90,8 @@ '((?- . over-and-under) "-----------" "Du bon vin tous les jours." "-----------") )) - (should (equal-buffer-return - '(find-title-line) + (should (ert-equal-buffer-return + (find-title-line) " Du bon vin tous les jours. \^@----------- @@ -101,8 +109,8 @@ '((?- . over-and-under) "-----------" "Du bon vin tous les jours." "-----------") )) - (should (equal-buffer-return - '(find-title-line) + (should (ert-equal-buffer-return + (find-title-line) " \^@----------- @@ -115,8 +123,8 @@ " nil )) - (should (equal-buffer-return - '(find-title-line) + (should (ert-equal-buffer-return + (find-title-line) " Line 1 \^@ @@ -131,8 +139,8 @@ " '((nil . nil) nil "Line 1" nil) )) - (should (equal-buffer-return - '(find-title-line) + (should (ert-equal-buffer-return + (find-title-line) " ===================================== Project Idea: Panorama Stitcher @@ -225,10 +233,10 @@ (ert-deftest rst-find-all-adornments () "Tests for `rst-find-all-adornments'." - (should (equal-buffer-return - '(rst-find-all-adornments) + (should (ert-equal-buffer-return + (rst-find-all-adornments) text-1 - nil + t '((2 ?= over-and-under 3) (7 ?= simple 0) (12 ?- simple 0) @@ -237,18 +245,18 @@ (26 ?~ over-and-under 1) (31 ?= simple 0)) )) - (should (equal-buffer-return - '(rst-find-all-adornments) + (should (ert-equal-buffer-return + (rst-find-all-adornments) text-2 - nil + t '((3 ?- simple 0) (6 ?~ simple 0) (9 ?+ simple 0)) )) - (should (equal-buffer-return - '(rst-find-all-adornments) + (should (ert-equal-buffer-return + (rst-find-all-adornments) text-3 - nil + t '((3 ?- simple 0) (6 ?~ simple 0)) )) @@ -256,10 +264,10 @@ (ert-deftest rst-get-hierarchy () "Tests for `rst-get-hierarchy'." - (should (equal-buffer-return - '(rst-get-hierarchy) + (should (ert-equal-buffer-return + (rst-get-hierarchy) text-1 - nil + t '((?= over-and-under 3) (?= simple 0) (?- simple 0) @@ -269,10 +277,10 @@ (ert-deftest rst-get-hierarchy-ignore () "Tests for `rst-get-hierarchy' with ignoring a line." - (should (equal-buffer-return - '(rst-get-hierarchy 26) + (should (ert-equal-buffer-return + (rst-get-hierarchy 26) text-1 - nil + t '((?= over-and-under 3) (?= simple 0) (?- simple 0)) @@ -281,225 +289,225 @@ (ert-deftest rst-adornment-level () "Tests for `rst-adornment-level'." - (should (equal-buffer-return - '(rst-adornment-level t) + (should (ert-equal-buffer-return + (rst-adornment-level t) text-1 - nil t + t )) - (should (equal-buffer-return - '(rst-adornment-level nil) + (should (ert-equal-buffer-return + (rst-adornment-level nil) text-1 + t nil - nil )) - (should (equal-buffer-return - '(rst-adornment-level (?= . over-and-under)) + (should (ert-equal-buffer-return + (rst-adornment-level (?= . over-and-under)) text-1 - nil + t 1 )) - (should (equal-buffer-return - '(rst-adornment-level (?= . simple)) + (should (ert-equal-buffer-return + (rst-adornment-level (?= . simple)) text-1 - nil + t 2 )) - (should (equal-buffer-return - '(rst-adornment-level (?- . simple)) + (should (ert-equal-buffer-return + (rst-adornment-level (?- . simple)) text-1 - nil + t 3 )) - (should (equal-buffer-return - '(rst-adornment-level (?~ . over-and-under)) + (should (ert-equal-buffer-return + (rst-adornment-level (?~ . over-and-under)) text-1 - nil + t 4 )) - (should (equal-buffer-return - '(rst-adornment-level (?# . simple)) + (should (ert-equal-buffer-return + (rst-adornment-level (?# . simple)) text-1 - nil + t 5 )) ) (ert-deftest rst-adornment-complete-p () "Tests for `rst-adornment-complete-p'." - (should (equal-buffer-return - '(rst-adornment-complete-p (?= simple 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= simple 0)) " \^@Vaudou " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= simple 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= simple 0)) " \^@Vaudou ====== " - nil + t t)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ====== \^@Vaudou ====== " - nil + t t)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 2)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 2)) " ========== \^@ Vaudou ========== " - nil + t t)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= simple 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= simple 0)) " \^@Vaudou ===== " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= simple 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= simple 0)) " \^@Vaudou ======= " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= simple 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= simple 0)) " \^@Vaudou ===-== " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ====== \^@Vaudou ===== " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ===== \^@Vaudou ====== " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ====== \^@Vaudou ===-== " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ===-== \^@Vaudou ====== " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ====== \^@Vaudou " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ====== \^@Vaudou ------ " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ========== \^@Vaudou ========= " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ========= \^@Vaudou ========== " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ========== \^@Vaudou ===-====== " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ===-====== \^@Vaudou ========== " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ========== \^@Vaudou " - nil + t nil)) - (should (equal-buffer-return - '(rst-adornment-complete-p (?= over-and-under 0)) + (should (ert-equal-buffer-return + (rst-adornment-complete-p (?= over-and-under 0)) " ========== \^@Vaudou ---------- " - nil + t nil)) ) (ert-deftest rst-get-adornments-around () "Tests for `rst-get-adornments-around'." - (should (equal-buffer-return - '(rst-get-adornments-around) + (should (ert-equal-buffer-return + (rst-get-adornments-around) " Previous @@ -511,10 +519,10 @@ ++++ " - nil + t '((?- simple 0) (?+ simple 0)))) - (should (equal-buffer-return - '(rst-get-adornments-around) + (should (ert-equal-buffer-return + (rst-get-adornments-around) " Previous @@ -527,7 +535,7 @@ ++++ " - nil + t '((?- simple 0) (?+ simple 0)))) ) @@ -565,8 +573,8 @@ (ert-deftest rst-classify-adornment () "Tests for `rst-classify-adornment'." - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " Du bon vin tous les jours @@ -577,8 +585,8 @@ '((?= . simple) nil "Du bon vin tous les jours" "=========================") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " Du bon vin tous les jours @@ -589,8 +597,8 @@ '((?= . simple) nil "Du bon vin tous les jours" "====================") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " Du bon vin tous les jours @@ -601,8 +609,8 @@ '((?= . simple) nil " Du bon vin tous les jours" "====================") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " Du bon vin tous les jours @@ -611,8 +619,8 @@ nil nil t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " Du bon vin tous les jours @@ -621,8 +629,8 @@ nil nil t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " Du bon vin tous les jours @@ -632,8 +640,8 @@ '((?- . simple) nil "Du bon vin tous les jours" "---") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " \^@~~~~~~~~~~~~~~~~~~~~~~~~~\^? Du bon vin tous les jours @@ -644,8 +652,8 @@ '((?~ . over-and-under) "~~~~~~~~~~~~~~~~~~~~~~~~~" "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) "~~~~~~~~~~~~~~~~~~~~~~~~~ Du bon vin tous les jours \^@~~~~~~~~~~~~~~~~~~~~~~~~~\^? @@ -655,8 +663,8 @@ '((?~ . over-and-under) "~~~~~~~~~~~~~~~~~~~~~~~~~" "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " \^@~~~~~~~~~~~~~~~~~~~~~~~~~\^? Du bon vin tous les jours @@ -667,8 +675,8 @@ '((?~ . over-and-under) "~~~~~~~~~~~~~~~~~~~~~~~~~" " Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " \^@~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\^? Du bon vin tous les jours @@ -679,8 +687,8 @@ '((?~ . over-and-under) "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " --------------------------- Du bon vin tous les jours @@ -691,15 +699,15 @@ '((?~ . simple) nil "Du bon vin tous les jours" "~~~~~~~~~~~~~~~~~~~~~~~~~~~") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) "\^@---------------------------\^?" nil '(t nil "---------------------------" nil) t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " \^@---------------------------\^? Du bon vin tous les jours @@ -709,8 +717,8 @@ nil nil t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " ========================= Du bon vin tous les jours @@ -722,8 +730,8 @@ '((?= . over-and-under) "=========================" "Du bon vin tous les jours" "=========================") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " ========================= Du bon vin tous les jours @@ -736,8 +744,8 @@ '((?- . simple) nil "Du bon vin" "----------") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " ========================= Du bon vin tous les jours @@ -751,8 +759,8 @@ '((?- . over-and-under) "----------" "Du bon vin" "----------") t)) - (should (equal-buffer-return - '(classify-adornment) + (should (ert-equal-buffer-return + (classify-adornment) " ========================= Du bon vin tous les jours Copied: trunk/docutils/tools/editors/emacs/tests/buffer.el (from rev 7444, trunk/docutils/tools/editors/emacs/tests/support.el) =================================================================== --- trunk/docutils/tools/editors/emacs/tests/buffer.el (rev 0) +++ trunk/docutils/tools/editors/emacs/tests/buffer.el 2012-07-30 19:29:33 UTC (rev 7490) @@ -0,0 +1,180 @@ +;;; buffer.el --- Test the test support for buffers + + +(add-to-list 'load-path ".") +(load "ert-buffer" nil t) + +;; **************************************************************************** +;; `ert-Buf' + +(defun roundtrip-ert-Buf (in) + (with-temp-buffer + (ert-Buf--to-buffer (ert-Buf-from-string in)) + (ert-Buf-string (ert-Buf-from-buffer)))) + +(ert-deftest ert-Buf () + "Tests for functions working with `ert-Buf's." + (should (equal (concat ert-Buf-point-char "abc\n") + (roundtrip-ert-Buf (concat ert-Buf-point-char "abc\n")))) + (should (equal (concat "a" ert-Buf-point-char "bc\n") + (roundtrip-ert-Buf (concat "a" ert-Buf-point-char "bc\n")))) + (should (equal (concat "ab" ert-Buf-point-char "c\n") + (roundtrip-ert-Buf (concat "ab" ert-Buf-point-char "c\n")))) + (should (equal (concat "abc" ert-Buf-point-char "\n") + (roundtrip-ert-Buf (concat "abc" ert-Buf-point-char "\n")))) + (should (equal (concat "abc\n" ert-Buf-point-char) + (roundtrip-ert-Buf (concat "abc\n" ert-Buf-point-char)))) + (should (equal (concat ert-Buf-point-char "abc\n" ert-Buf-mark-char "") + (roundtrip-ert-Buf + (concat ert-Buf-point-char "abc\n" ert-Buf-mark-char "")))) + (should (equal (concat ert-Buf-mark-char "abc\n" ert-Buf-point-char) + (roundtrip-ert-Buf + (concat ert-Buf-mark-char "abc\n" ert-Buf-point-char)))) + (should (equal (concat "a" ert-Buf-mark-char ert-Buf-point-char "bc\n") + (roundtrip-ert-Buf + (concat "a" ert-Buf-point-char "" ert-Buf-mark-char "bc\n")))) + (should (equal (concat "ab" ert-Buf-mark-char "" ert-Buf-point-char "c\n") + (roundtrip-ert-Buf + (concat "ab" ert-Buf-mark-char ert-Buf-point-char "c\n")))) + (should-error (ert-Buf-from-string + (concat "ab" ert-Buf-point-char ert-Buf-point-char "c\n"))) + (should-error (ert-Buf-from-string + (concat "ab" ert-Buf-mark-char ert-Buf-mark-char "c\n"))) + ) + +(ert-deftest ert-Buf--from-argument () + "Test `ert-Buf--from-argument'." + (let ((marked-a (ert-Buf-from-string + (concat ert-Buf-point-char "a" ert-Buf-mark-char)))) + (should (not (ert-Buf--from-argument nil nil))) + (should (equal (ert-Buf--from-argument ?a nil) + (ert-Buf-from-string "a"))) + (should (equal (ert-Buf--from-argument ert-Buf-point-char nil) + (ert-Buf-from-string ert-Buf-point-char))) + (should (equal (ert-Buf--from-argument '("a" "b") nil) + (ert-Buf-from-string "ab"))) + (should (equal (ert-Buf--from-argument `("a" ,ert-Buf-point-char "b") nil) + (ert-Buf-from-string (concat "a" ert-Buf-point-char "b")))) + (should (equal (ert-Buf--from-argument marked-a nil) marked-a)) + (should-error (ert-Buf--from-argument -1 nil)) + (should-error (ert-Buf--from-argument [0] nil)) + (should-error (ert-Buf--from-argument t nil)) + (should-error (ert-Buf--from-argument t t)) + (should (eq (ert-Buf--from-argument t marked-a) marked-a)) + )) + +;; **************************************************************************** +;; Advice `ert-completing-read' + +(defvar read-fun-args nil + "Input for for functions reading the minibuffer. +Consists of a list of functions and their argument lists to be +run successively. Prompt is omitted.") + +(defun insert-reads () + (interactive) + (while read-fun-args + (let* ((fun-arg (pop read-fun-args)) + (result (apply (car fun-arg) "" (cdr fun-arg)))) + (insert (if (integerp result) + (int-to-string result) + result) "\n")))) + +(defun test-reads (inputs fun-args result) + (setq read-fun-args fun-args) + (ert-equal-buffer (insert-reads) "" result inputs)) + +(ert-deftest reads () + "Tests for functions using `completing-read's." + (should (test-reads '(5) '((read-number)) "5\n")) + (should (test-reads nil nil "")) + (should-error (test-reads '("") nil "")) ;; Too much input. + (should-error (test-reads '(5) '((read-number) + (read-number)) "")) ;; Too less input. + (should (test-reads '("") '((completing-read nil)) "\n")) + (should (test-reads '("" "") '((completing-read nil) + (completing-read nil)) "\n\n")) + (should (test-reads '("a" "b") '((completing-read nil) + (completing-read nil)) "a\nb\n")) + (should (test-reads '("a" "b") '((completing-read ("a" "b")) + (completing-read ("a" "b"))) "a\nb\n")) + (should (test-reads '("a" "b") '((completing-read ("a" "b")) + (completing-read ("a"))) "a\nb\n")) + (should-error (test-reads '("a" "b") + '((completing-read ("a" "b")) + (completing-read ("a") nil t)) "a\nb\n")) ;; Invalid input. + (should (test-reads '("a" "") + '((completing-read ("a" "b")) + (completing-read ("a") nil t)) "a\n\n")) + (should-error (test-reads '("a" "") + '((completing-read ("a" "b")) + (completing-read ("a") nil 'non-empty)) "a\n\n")) + (should (test-reads '("x") '((read-string)) "x\n")) + (should (test-reads '("") '((read-string nil nil "x")) "x\n")) + (should (test-reads '("y") '((read-string nil nil "x")) "y\n")) + (should (test-reads '("") '((read-number 5)) "5\n")) + (should (test-reads '(0) '((read-number 5)) "0\n")) + ) + +;; **************************************************************************** +;; Test main functions + +(ert-deftest ert-equal-buffer () + "Tests for `ert-equal-buffer'." + (should (ert-equal-buffer (insert "foo") + (concat ert-Buf-point-char ert-Buf-mark-char) + (concat ert-Buf-mark-char "foo" + ert-Buf-point-char))) + (should (ert-equal-buffer (delete-region) + (concat ert-Buf-mark-char "foo" + ert-Buf-point-char) + (concat ert-Buf-point-char ert-Buf-mark-char) + t)) + (should (ert-equal-buffer (delete-region 1 4) + "foo" + "")) + (should-error (ert-equal-buffer (delete-region 0 3) + (concat "foo") + "") :type 'args-out-of-range) + (should (ert-equal-buffer (goto-char 4) + "foo" + (concat "foo" ert-Buf-point-char))) + ) + +(ert-deftest ert-equal-buffer-return () + "Tests for `ert-equal-buffer-return'." + (should (ert-equal-buffer-return (buffer-substring-no-properties 4 1) + "foo" + t + "foo")) + (should (ert-equal-buffer-return (delete-and-extract-region 1 4) + "foo" + "" + "foo")) + (should (ert-equal-buffer-return (point) + ert-Buf-point-char + t + 1)) + (should (ert-equal-buffer-return (point) + (concat " " ert-Buf-point-char) + t + 2)) + (should (ert-equal-buffer-return (region-beginning) + (concat ert-Buf-point-char " " + ert-Buf-mark-char) + t + 1)) + (should (ert-equal-buffer-return (region-end) + (concat ert-Buf-mark-char " " + ert-Buf-point-char) + t + 2)) + (should (ert-equal-buffer-return (following-char) + (concat ert-Buf-point-char "A") + t + ?A)) + (should (ert-equal-buffer-return (following-char) + (concat "A" ert-Buf-point-char) + t + 0)) + ) Added: trunk/docutils/tools/editors/emacs/tests/cl.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/cl.el (rev 0) +++ trunk/docutils/tools/editors/emacs/tests/cl.el 2012-07-30 19:29:33 UTC (rev 7490) @@ -0,0 +1,57 @@ +;; Tests for replacement functions for `cl.el' + +(add-to-list 'load-path "..") +(load "rst.el" nil t) + +(ert-deftest rst-signum () + "Test `rst-signum'." + (should (equal (rst-signum 10) 1)) + (should (equal (rst-signum -10) -1)) + (should (equal (rst-signum 0) 0)) + ) + +(ert-deftest rst-some () + "Test `rst-some'." + (should (equal (rst-some nil) nil)) + (should (equal (rst-some '(t)) t)) + (should (equal (rst-some '(0)) 0)) + (should (equal (rst-some '(1)) 1)) + (should (equal (rst-some '(nil 1)) 1)) + (should (equal (rst-some '(nil nil)) nil)) + (should (equal (rst-some nil 'not) nil)) + (should (equal (rst-some '(t) 'not) nil)) + (should (equal (rst-some '(0) 'not) nil)) + (should (equal (rst-some '(1 nil) 'not) t)) + (should (equal (rst-some '(nil 1) 'not) t)) + (should (equal (rst-some '(nil nil) 'not) t)) + ) + +(ert-deftest rst-position () + "Test `rst-position'." + (should (equal (rst-position nil nil) nil)) + (should (equal (rst-position t '(nil)) nil)) + (should (equal (rst-position nil '(t)) nil)) + (should (equal (rst-position nil '(nil)) 0)) + (should (equal (rst-position t '(t)) 0)) + (should (equal (rst-position t '(nil t)) 1)) + (should (equal (rst-position t '(nil t t nil sym)) 1)) + (should (equal (rst-position t '(nil (t) t nil sym)) 2)) + (should (equal (rst-position 'sym '(nil (t) t nil sym)) 4)) + (should (equal (rst-position 'sym '(nil (t) t nil t)) nil)) + (should (equal (rst-position '(t) '(nil (t) t nil sym)) 1)) + (should (equal (rst-position '(1 2 3) '(nil (t) t nil sym)) nil)) + (should (equal (rst-position '(1 2 3) '(nil (t) t (1 2 3) t)) 3)) + (should (equal (rst-position '(1 2 3) '(nil (t) t (1 2 3) (1 2 3))) 3)) + ) + +(ert-deftest rst-position-if () + "Test `rst-position-if'." + (should (equal (rst-position-if 'not '(t nil nil)) 1)) + + (should (equal (rst-position-if 'not nil) nil)) + (should (equal (rst-position-if 'identity '(nil)) nil)) + (should (equal (rst-position-if 'not '(t)) nil)) + (should (equal (rst-position-if 'not '(nil)) 0)) + (should (equal (rst-position-if 'not '(nil nil)) 0)) + (should (equal (rst-position-if 'not '(t t nil)) 2)) + ) Modified: trunk/docutils/tools/editors/emacs/tests/comment.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/comment.el 2012-07-22 22:08:08 UTC (rev 7489) +++ trunk/docutils/tools/editors/emacs/tests/comment.el 2012-07-30 19:29:33 UTC (rev 7490) @@ -1,8 +1,16 @@ ;; Tests for comment handling (add-to-list 'load-path ".") -(load "ert-support" nil t) +(load "ert-buffer" nil t) +(add-to-list 'load-path "..") +(load "rst.el" nil t) +(ert-deftest comment-asserts () + "Check some assertions." + (should (equal ert-Buf-point-char "\^@")) + (should (equal ert-Buf-mark-char "\^?")) + ) + (defun cmnt-insert () "Wrapper to insert comment via `comment-dwim'. Must be called on a line conaining at most whitespace." @@ -16,20 +24,20 @@ (let ((rst-indent-width 2) (rst-indent-comment 3) (fill-column 20)) - (should (equal-buffer - '(cmnt-insert) + (should (ert-equal-buffer + (cmnt-insert) "\^@" ".. \^@" )) - (should (equal-buffer - '(cmnt-insert) + (should (ert-equal-buffer + (cmnt-insert) " \^@" " .. \^@" )) - (should (equal-buffer - '(cmnt-insert) + (should (ert-equal-buffer + (cmnt-insert) " * bla @@ -39,8 +47,8 @@ .. \^@" )) - (should (equal-buffer - '(cmnt-insert) + (should (ert-equal-buffer + (cmnt-insert) " :Field: Content @@ -64,25 +72,25 @@ (let ((rst-indent-width 2) (rst-indent-comment 3) (fill-column 20)) - (should (equal-buffer - '(cmnt-indent nil) + (should (ert-equal-buffer + (cmnt-indent nil) "\^@" ".. \^@" )) - (should (equal-buffer - '(cmnt-indent nil) + (should (ert-equal-buffer + (cmnt-indent nil) " \^@" " .. \^@" )) - (should (equal-buffer - '(cmnt-indent nil) + (should (ert-equal-buffer + (cmnt-indent nil) ".. comment\^@" ".. \^@comment" )) - (should (equal-buffer - '(cmnt-indent nil) + (should (ert-equal-buffer + (cmnt-indent nil) " * bla @@ -92,8 +100,8 @@ .. \^@comment" )) - (should (equal-buffer - '(cmnt-indent nil) + (should (ert-equal-buffer + (cmnt-indent nil) " :Field: Content @@ -103,8 +111,8 @@ .. \^@" )) - (should (equal-buffer - '(cmnt-indent nil) + (should (ert-equal-buffer + (cmnt-indent nil) " :Field: Content @@ -128,14 +136,14 @@ (let ((rst-indent-width 2) (rst-indent-comment 3) (fill-column 20)) - (should (equal-buffer - '(uncmnt-region) + (should (ert-equal-buffer + (uncmnt-region) "\^?.. com\^@ment" "\^?com\^@ment" )) - (should (equal-buffer - '(uncmnt-region) + (should (ert-equal-buffer + (uncmnt-region) "\^?.. com\^@ment @@ -146,8 +154,8 @@ bla " )) - (should (equal-buffer - '(uncmnt-region) + (should (ert-equal-buffer + (uncmnt-region) "\^?.. comment @@ -172,14 +180,14 @@ (let ((rst-indent-width 2) (rst-indent-comment 3) (fill-column 20)) - (should (equal-buffer - '(cmnt-region) + (should (ert-equal-buffer + (cmnt-region) "\^?com\^@ment" "\^?.. com\^@ment" )) - (should (equal-buffer - '(cmnt-region) + (should (ert-equal-buffer + (cmnt-region) "\^?com\^@ment bla @@ -190,8 +198,8 @@ bla " )) - (should (equal-buffer - '(cmnt-region) + (should (ert-equal-buffer + (cmnt-region) "\^?comment bl\^@a Copied: trunk/docutils/tools/editors/emacs/tests/ert-buffer.el (from rev 7444, trunk/docutils/tools/editors/emacs/tests/ert-support.el) =================================================================== --- trunk/docutils/tools/editors/emacs/tests/ert-buffer.el (rev 0) +++ trunk/docutils/tools/editors/emacs/tests/ert-buffer.el 2012-07-30 19:29:33 UTC (rev 7490) @@ -0,0 +1,411 @@ +;;; ert-buffer.el --- Support functions for running ert tests on buffers + +;; Copyright (C) 2010-2012 Free Software Foundation, Inc. + +;; Author: Stefan Merten <sm...@oe...>, + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Some functions need a buffer to run on. They may use the buffer content as +;; well as point and mark as input and may modify all of them. In addition +;; they may return some result. Here are some support functions to test such +;; functions using `ert'. +;; +;; Use `ert-equal-buffer' and/or `ert-equal-buffer-return' for your `should' +;; forms. +;; +;; You may use the constants `ert-Buf-point-char' and `ert-Buf-mark-char' in +;; constructing comparison strings to represent point or mark, respectively. +;; +;; Examples: +;; +;; (should (ert-equal-buffer (insert "foo") +;; ; Insertion of "foo"... +;; (concat ert-Buf-point-char ert-Buf-mark-char) +;; ; ...into an empty buffer with point and mark... +;; (concat ert-Buf-mark-char "foo" +;; ert-Buf-point-char))) +;; ; ...should result in a buffer containing "foo" +;; ; with point and mark moved appropriately. +;; +;; (should (ert-equal-buffer (delete-region) +;; ; Deleting region... +;; `(,ert-Buf-mark-char "foo" ,ert-Buf-point-char) +;; ; ...in a region spanning the whole buffer... +;; (concat ert-Buf-point-char ert-Buf-mark-char) +;; ; ...should result in an empty buffer... +;; t)) +;; ; ...when called interactively. +;; +;; (should (ert-equal-buffer-return (point) +;; ; Returning the point... +;; ert-Buf-point-char +;; ; ...in an empty buffer... +;; t +;; ; ...without changing the result buffer... +;; 1)) +;; ; ...should return 1. + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'ert) + +;; **************************************************************************** +;; `ert-Buf' and related functions + +(defconst ert-Buf-point-char "\^@" + "Special character used to mark the position of point in a `ert-Buf'.") + +(defconst ert-Buf-mark-char "\^?" + "Special character used to mark the position of mark in a `ert-Buf'.") + +(defstruct (ert-Buf + (:constructor nil) ; No default constructor. + (:constructor ert-Buf-from-string + (string + &aux + (analysis (ert-Buf--parse-string string)) + (content (car analysis)) + (point (cadr analysis)) + (mark (caddr analysis)))) + (:constructor ert-Buf-from-buffer + (&aux + (content (buffer-substring-no-properties + (point-min) (point-max))) + (point (point)) + (mark (mark t)) + (string + (ert-Buf--create-string content point mark))))) + "Structure to hold comparable information about a buffer. +`ert-Buf-from-string' constructs a structure from a given STRING. +`ert-Buf-from-buffer' constructs a structure from the current +buffer." + (content nil :read-only t) ; Pure string content without any special markup. + (point nil :read-only t) ; Position of point. + (mark nil :read-only t) ; Position of mark. + (string nil :read-only t) ; String representation. + ) + +(defun ert-Buf--parse-string (string) + "Parse STRING and return clean results. +Return a list consisting of the cleaned content, the position of +point if `ert-Buf-point-char' was found and the the position of mark +if `ert-Buf-mark-char' was found." + (with-temp-buffer + (let ((case-fold-search nil) + fnd point-fnd mark-fnd) + (insert string) + (goto-char (point-min)) + (while (re-search-forward + (concat "[" ert-Buf-point-char ert-Buf-mark-char "]") nil t) + (setq fnd (match-string 0)) + (replace-match "") + (cond + ((equal fnd ert-Buf-point-char) + (if point-fnd + (error "Duplicate point")) + (setq point-fnd (point))) + ((equal fnd ert-Buf-mark-char) + (if mark-fnd + (error "Duplicate mark")) + (setq mark-fnd (point))) + (t + (error "Unexpected marker found")))) + (list (buffer-substring-no-properties (point-min) (point-max)) + point-fnd mark-fnd)))) + +(defun ert-Buf--create-string (content point mark) + "Create a string representation from CONTENT, POINT and MARK." + (with-temp-buffer + (insert content) + (let (pnt-chs) + (if point + (setq pnt-chs (nconc pnt-chs (list (cons point ert-Buf-point-char))))) + (if mark + (setq pnt-chs (nconc pnt-chs (list (cons mark ert-Buf-mark-char))))) + ;; Sort pairs so the highest position is last. + (setq pnt-chs (sort pnt-chs (lambda (el1 el2) (> (car el1) (car el2))))) + (while pnt-chs + (goto-char (caar pnt-chs)) + (insert (cdar pnt-chs)) + (setq pnt-chs (cdr pnt-chs))) + (buffer-substring-no-properties (point-min) (point-max))))) + +(defun ert-Buf--to-buffer (buf) + "Set current buffer according to BUF." + (insert (ert-Buf-content buf)) + (if (ert-Buf-point buf) + (goto-char (ert-Buf-point buf))) + (if (ert-Buf-mark buf) + (set-mark (ert-Buf-mark buf)))) + +(defun ert-Buf--from-argument (arg other) + "Interpret ARG as input for an `ert-Buf', convert it and return the `ert-Buf'. +ARG may be one of the types described in +`ert-equal-buffer-return' or nil which is also returned." + (cond + ((not arg) + nil) + ((eq arg t) + (when (or (not other) (eq other t)) + (error "First argument to `ert-Buf--from-argument' t requires a non-nil, non-t second argument")) + (ert-Buf--from-argument other nil)) + ((characterp arg) + (ert-Buf-from-string (char-to-string arg))) + ((stringp arg) + (ert-Buf-from-string arg)) + ((ert-Buf-p arg) + arg) + ((listp arg) + (ert-Buf-from-string (apply 'concat arg))) + (t + (error "Unknown type for `ert-Buf--from-argument'")))) + +;; **************************************************************************** +;; Runners + +(defvar ert--inputs nil + "Variable to hold the strings to give successively to `ert-completing-read'.") + +(defadvice completing-read (around ert-completing-read first + (prompt collection &optional predicate + require-match initial-input hist + def inherit-input-method)) + "Advice `completing-read' to accept input from `ert--inputs'." + (if (not ert--inputs) + (error "No more input strings in `ert--inputs'")) + (let* ((input (pop ert--inputs))) + (setq ad-return-value + (cond + ((eq (try-completion input collection predicate) t) ;; Perfect match. + input) + ((not require-match) ;; Non-matching input allowed. + input) + ((and (equal input "") + (eq require-match t)) ;; Empty input and this is allowed. + input) + (t + (error + "Input '%s' is not allowed for `completing-read' expecting %s" + input collection)))))) + +(defadvice read-string (around ert-read-string first + (prompt &optional initial-input history + default-value inherit-input-method)) + "Advice `read-string' to accept input from `ert--inputs'." + (if (not ert--inputs) + (error "No more input strings in `ert--inputs'")) + (let* ((input (pop ert--inputs))) + (setq ad-return-value + (if (and (equal input "") default-value) + default-value + input)))) + +(defadvice read-number (around ert-read-number first + (prompt &optional default)) + "Advice `read-number' to accept input from `ert--inputs'." + (if (not ert--inputs) + (error "No more input strings in `ert--inputs'")) + (let* ((input (pop ert--inputs))) + (setq ad-return-value + (if (and (equal input "") default) + default + input)))) + +(defun ert--run-test-with-buffer (buf form interactive) + "With a buffer filled with `ert-Buf' BUF evaluate function form FORM. +Return a cons consisting of the return value and a `ert-Buf'. If +INTERACTIVE is non-nil FORM is evaluated in an interactive +environment." + (with-temp-buffer + (ert-Buf--to-buffer buf) + (let ((act-return + (cond + ((not interactive) + (apply (car form) (cdr form))) + ((eq interactive t) + (let ((current-prefix-arg (cadr form))) + (call-interactively (car form)))) + ((listp interactive) + (setq ert--inputs interactive) + (ad-activate 'read-string) + (ad-activate 'read-number) + (ad-activate 'completing-read) + (unwind-protect + (let ((current-prefix-arg (cadr form))) + (call-interactively (car form))) + (progn + (ad-deactivate 'completing-read) + (ad-deactivate 'read-number) + (ad-deactivate 'read-string))) + (if ert--inputs + (error "%d input strings left over" + (length ert--inputs)))))) + (act-buf (ert-Buf-from-buffer))) + (cons act-return act-buf)))) + +(defun ert--compare-test-with-buffer (result buf ignore-return exp-return) + "Compare RESULT of test with expected buffer BUF. +RESULT is a return value from `ert--run-test-with-buffer'. +Return a list of booleans where t stands for a successful test of +this kind: + +* Content of output buffer +* Point in output buffer +* Return value + +IGNORE-RETURN, EXP-RETURN are described in `ert--equal-buffer'." + (let ((act-return (car result)) + (act-buf (cdr result))) + (list + (or (not buf) + (equal (ert-Buf-content act-buf) (ert-Buf-content buf))) + (or + (not buf) + (not (ert-Buf-point buf)) + (equal (ert-Buf-point act-buf) (ert-Buf-point buf))) + (or ignore-return + (equal act-return exp-return))))) + +(defun ert--equal-buffer (form input exp-output ignore-return exp-return interactive) + "Run tests for `ert-equal-buffer-return' and `ert-equal-buffer'. +FORM, INPUT and EXP-OUTPUT are as described for +`ert-equal-buffer-return'. Ignore return value if IGNORE-RETURN +or compare the return value to EXP-RETURN. INTERACTIVE is as +described for `ert-equal-buffer-return'. Return t if equal." + (catch 'return + (dolist (elem (ert--compare-test-with-buffer + (ert--run-test-with-buffer + (ert-Buf--from-argument input exp-output) form interactive) + (ert-Buf--from-argument exp-output input) + ignore-return exp-return) t) + (unless elem + (throw 'return nil))))) + +(defmacro ert-equal-buffer-return (form input exp-output exp-return &optional interactive) + "Evaluate function form FORM with a buffer and compare results. +Since `ert-equal-buffer-return' is a macro FORM is not evaluated +immediately. Thus you must give FORM as a normal function form +with no additional quoting. + +The buffer is filled with INPUT. Compare the buffer content to +EXP-OUTPUT if this is non-nil. Compare the return value to +EXP-RETURN. Return t if buffer and return value are equal to the +expected values. + +INPUT and EXP-OUTPUT represent the input buffer or the expected +output buffer, respectively. They can be one of the following: + +* nil in which case the respective buffer is not used. Makes + sense only for EXP-OUTPUT. +* t in which case the other buffer is used unchanged. The other + buffer must not be nil or t in this case. +* A character which is converted to a one character string. +* A string. +* A list of strings which are concatenated using `concat'. This + can be used to shorten the form describing the buffer when used + with quote or backquote. +* An `ert-Buf' object. + +All input variants which end up in a string are parsed by +`ert-Buf-from-string'. + +If INTERACTIVE is nil FORM is evaluated with no special context. +If INTERACTIVE is non-nil FORM is evaluated interactively and +`current-prefix-arg' i... [truncated message content] |
From: <sm...@us...> - 2012-09-20 21:29:01
|
Revision: 7515 http://docutils.svn.sourceforge.net/docutils/?rev=7515&view=rev Author: smerten Date: 2012-09-20 21:28:53 +0000 (Thu, 20 Sep 2012) Log Message: ----------- 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`. Modified Paths: -------------- trunk/docutils/tools/editors/emacs/IDEAS.rst trunk/docutils/tools/editors/emacs/rst.el trunk/docutils/tools/editors/emacs/tests/adjust-section.el trunk/docutils/tools/editors/emacs/tests/adornment.el trunk/docutils/tools/editors/emacs/tests/buffer.el trunk/docutils/tools/editors/emacs/tests/cl.el trunk/docutils/tools/editors/emacs/tests/comment.el trunk/docutils/tools/editors/emacs/tests/fill.el trunk/docutils/tools/editors/emacs/tests/font-lock.el trunk/docutils/tools/editors/emacs/tests/indent.el trunk/docutils/tools/editors/emacs/tests/items.el trunk/docutils/tools/editors/emacs/tests/movement.el trunk/docutils/tools/editors/emacs/tests/re.el trunk/docutils/tools/editors/emacs/tests/shift.el trunk/docutils/tools/editors/emacs/tests/toc.el Added Paths: ----------- trunk/docutils/tools/editors/emacs/tests/imenu.el trunk/docutils/tools/editors/emacs/tests/init.el trunk/docutils/tools/editors/emacs/tests/tree.el Property Changed: ---------------- trunk/docutils/tools/editors/emacs/ Property changes on: trunk/docutils/tools/editors/emacs ___________________________________________________________________ Modified: svn:ignore - tests.tgz .dist.ok dist version.gmk .tests.ok .build.ok .cvsignore .svnignore build MANIFEST .*.gmk Makefile CVS lib2project docs examples patches global.log tag.log cvsTags.rst + tests.tgz .dist.ok dist version.gmk .tests.ok .build.ok .cvsignore .svnignore build MANIFEST docutilsOptions.rst .*.gmk Makefile CVS lib2project docs examples patches global.log tag.log cvsTags.rst Modified: trunk/docutils/tools/editors/emacs/IDEAS.rst =================================================================== --- trunk/docutils/tools/editors/emacs/IDEAS.rst 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/IDEAS.rst 2012-09-20 21:28:53 UTC (rev 7515) @@ -123,6 +123,8 @@ * See `imenu` documentation and `speedbar-use-imenu-flag` + * See `speedbar` + toc-mode without markup ======================= @@ -218,6 +220,8 @@ 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 @@ * 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 @@ * 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 @@ 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` Modified: trunk/docutils/tools/editors/emacs/rst.el =================================================================== --- trunk/docutils/tools/editors/emacs/rst.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/rst.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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 @@ ;; 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 @@ ;; 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 @@ 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 @@ (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 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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 @@ 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 @@ (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 @@ (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,8 +1014,8 @@ 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, @@ -979,7 +1035,8 @@ (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 @@ 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 @@ ;; 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 @@ ;; 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ 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 @@ `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,10 +1423,8 @@ (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." ;; Note: we assume that the detection of the overline as being the underline @@ -1369,8 +1436,7 @@ (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 @@ (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 @@ 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 @@ (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 @@ (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 @@ (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 @@ (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 @@ ;; 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 @@ (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,11 +1881,8 @@ (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))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Insert list items @@ -1906,7 +1962,7 @@ (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 @@ :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,131 +2180,113 @@ ;; 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)))) + (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. -(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." +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))) - (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))) + ;; 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)))) + (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)))) - ;; Return this node with its children. - (cons node 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))))) -(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) - )) - - (defgroup rst-toc nil "Settings for reStructuredText table of contents." :group 'rst @@ -2257,6 +2296,7 @@ "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 @@ - 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,8 +2324,8 @@ (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. By default the top level is ignored if there is only one, because @@ -2316,8 +2358,7 @@ (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 @@ ;; 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 @@ ((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 @@ (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,11 +2427,9 @@ indent (if do-child-numbering (concat pfx (format fmt count)) pfx)) - (incf count))) + (incf count)))))) - ))) - (defun rst-toc-update () "Automatically find the contents section of a document and update. Updates the inserted TOC if present. You can use this in your @@ -2468,8 +2502,7 @@ ;; 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 @@ 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 @@ ;; 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 @@ ;; 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 @@ (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 @@ (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 @@ (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,18 +2770,15 @@ (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. (defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body) @@ -2785,14 +2810,11 @@ (,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 @@ "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 @@ (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 @@ (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,19 +3168,14 @@ (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))))) - - ;;------------------------------------------------------------------------------ (defun rst-line-block-region (rbeg rend &optional pfxarg) @@ -3202,6 +3222,7 @@ :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 @@ :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 @@ :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 @@ "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 @@ :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 @@ :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 @@ "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 @@ :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 @@ :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 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; 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. +(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")) -(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") +;; 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")) -(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))) +(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")) -;; 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 +(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")) - `rst-level-face-base-light' - + (`rst-level-face-max' - 1) * `rst-level-face-step-light' +(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")) -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) +(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,33 +3425,9 @@ (integer :tag "Section level") (const :tag "transitions" t) (const :tag "section title adornment" nil)) - :value-type (face)) - :set-after '(rst-level-face-max)) + :value-type (face))) +(rst-testcover-defcustom) -(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) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar rst-font-lock-keywords @@ -3663,8 +3619,7 @@ ;; 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 :tag "Options")))) :group 'rst :package-version "1.2.0") +(rst-testcover-defcustom) ;; FIXME: Must be `defcustom`. (defvar rst-compile-primary-toolset 'html @@ -3999,12 +3955,9 @@ (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) @@ -4041,8 +3994,7 @@ ;; 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 @@ )) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Imenu support. + +;; FIXME: Integrate this properly. Consider a key binding. + +;; Based on code from Masatake YAMATO <ya...@re...>. + +(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 @@ (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,18 +4200,8 @@ (point)) ;; Fill with last characters. (insert-char (preceding-char) - (- rightmost-column (current-column)))) - )) + (- 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))) - ;; LocalWords: docutils http sourceforge rst html wp svn svnroot txt reST regex Modified: trunk/docutils/tools/editors/emacs/tests/adjust-section.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/adjust-section.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/adjust-section.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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." Modified: trunk/docutils/tools/editors/emacs/tests/adornment.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/adornment.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/adornment.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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." Modified: trunk/docutils/tools/editors/emacs/tests/buffer.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/buffer.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/buffer.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -1,6 +1,5 @@ ;;; buffer.el --- Test the test support for buffers - (add-to-list 'load-path ".") (load "ert-buffer" nil t) Modified: trunk/docutils/tools/editors/emacs/tests/cl.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/cl.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/cl.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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'." Modified: trunk/docutils/tools/editors/emacs/tests/comment.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/comment.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/comment.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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." Modified: trunk/docutils/tools/editors/emacs/tests/fill.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/fill.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/fill.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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." Modified: trunk/docutils/tools/editors/emacs/tests/font-lock.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/font-lock.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/font-lock.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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." Added: trunk/docutils/tools/editors/emacs/tests/imenu.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/imenu.el (rev 0) +++ trunk/docutils/tools/editors/emacs/tests/imenu.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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. Modified: trunk/docutils/tools/editors/emacs/tests/indent.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/indent.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/indent.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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." Added: trunk/docutils/tools/editors/emacs/tests/init.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/init.el (rev 0) +++ trunk/docutils/tools/editors/emacs/tests/init.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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))) Modified: trunk/docutils/tools/editors/emacs/tests/items.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/items.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/items.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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." Modified: trunk/docutils/tools/editors/emacs/tests/movement.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/movement.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/movement.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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." Modified: trunk/docutils/tools/editors/emacs/tests/re.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/re.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/re.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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'." Modified: trunk/docutils/tools/editors/emacs/tests/shift.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/shift.el 2012-09-14 14:27:12 UTC (rev 7514) +++ trunk/docutils/tools/editors/emacs/tests/shift.el 2012-09-20 21:28:53 UTC (rev 7515) @@ -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." Modified: trunk/docutils/tools/editors/emacs/tests/toc.el =======================... [truncated message content] |
From: <sm...@us...> - 2015-10-04 09:21:37
|
Revision: 7925 http://sourceforge.net/p/docutils/code/7925 Author: smerten Date: 2015-10-04 09:21:35 +0000 (Sun, 04 Oct 2015) Log Message: ----------- Update tutorial. Works with `electric-indent-mode` switched on globally in Emacs 24.4. Includes changes made in Emacs tree matching Emacs commit ``db828f62f6f17414fbbc3206dac123dc73dd6055`` of 2015-09-21 16:51:20 (GMT). Modified Paths: -------------- trunk/docutils/tools/editors/emacs/rst.el trunk/docutils/tools/editors/emacs/tests/fill.el trunk/docutils/tools/editors/emacs/tests/toc.el Modified: trunk/docutils/tools/editors/emacs/rst.el =================================================================== --- trunk/docutils/tools/editors/emacs/rst.el 2015-10-04 08:23:22 UTC (rev 7924) +++ trunk/docutils/tools/editors/emacs/rst.el 2015-10-04 09:21:35 UTC (rev 7925) @@ -1,6 +1,6 @@ ;;; rst.el --- Mode for viewing and editing reStructuredText-documents. -;; Copyright (C) 2003-2012 Free Software Foundation, Inc. +;; Copyright (C) 2003-2015 Free Software Foundation, Inc. ;; Maintainer: Stefan Merten <sm...@oe...> ;; Author: Stefan Merten <sm...@oe...>, @@ -118,7 +118,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for `testcover' -(when (boundp 'testcover-1value-functions) +(when (and (boundp 'testcover-1value-functions) + (boundp 'testcover-compose-functions)) ;; Below `lambda' is used in a loop with varying parameters and is thus not ;; 1valued. (setq testcover-1value-functions @@ -217,7 +218,7 @@ ;; Use CVSHeader to really get information from CVS and not other version ;; control systems. (defconst rst-cvs-header - "$CVSHeader: sm/rst_el/rst.el,v 1.326 2012-09-20 21:28:04 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.24 2015/10/04 09:08:14 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -242,7 +243,7 @@ ;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.4.0 %") + "%OfficialVersion: 1.4.1 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " @@ -266,6 +267,7 @@ ("1.3.0" . "24.3") ("1.3.1" . "24.3") ("1.4.0" . "24.3") + ("1.4.1" . "24.5") )) (unless (assoc rst-official-version rst-package-emacs-version-alist) @@ -295,7 +297,7 @@ ;; syntax. (defconst rst-bullets ;; Sorted so they can form a character class when concatenated. - '(?- ?* ?+ ?\u2022 ?\u2023 ?\u2043) + '(?- ?* ?+ ?• ?‣ ?⁃) "List of all possible bullet characters for bulleted lists.") (defconst rst-uri-schemes @@ -391,8 +393,8 @@ ; item tag. ;; Inline markup (`ilm') - (ilm-pfx (:alt "^" hws-prt "[-'\"([{<\u2018\u201c\u00ab\u2019/:]")) - (ilm-sfx (:alt "$" hws-prt "[]-'\")}>\u2019\u201d\u00bb/:.,;!?\\]")) + (ilm-pfx (:alt "^" hws-prt "[-'\"([{<‘“«’/:]")) + (ilm-sfx (:alt "$" hws-prt "[]-'\")}>’”»/:.,;!?\\]")) ;; Inline markup content (`ilc') (ilcsgl-tag "\\S ") ; A single non-white character. @@ -441,7 +443,7 @@ (opt-tag (:shy optsta-tag optnam-tag optarg-tag "?")) ; A complete option. ;; Footnotes and citations (`fnc') - (fncnam-prt "[^\]\n]") ; Part of a footnote or citation name. + (fncnam-prt "[^]\n]") ; Part of a footnote or citation name. (fncnam-tag fncnam-prt "+") ; A footnote or citation name. (fnc-tag "\\[" fncnam-tag "]") ; A complete footnote or citation tag. (fncdef-tag-2 (:grp exm-sta) @@ -511,7 +513,7 @@ ; colon tag. ;; Comments (`cmt') - (cmt-sta-1 (:grp exm-sta) "[^\[|_\n]" + (cmt-sta-1 (:grp exm-sta) "[^[|_\n]" (:alt "[^:\n]" (:seq ":" (:alt "[^:\n]" "$"))) "*$") ; Start of a comment block; first group is explicit markup ; start. @@ -527,7 +529,7 @@ (defvar rst-re-alist) ; Forward declare to use it in `rst-re'. -;; FIXME: Use `sregex` or `rx` instead of re-inventing the wheel. +;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel. (rst-testcover-add-compose 'rst-re) ;; testcover: ok. (defun rst-re (&rest args) @@ -607,20 +609,31 @@ (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))) @@ -766,17 +779,15 @@ (modify-syntax-entry ?\\ "\\" st) (modify-syntax-entry ?_ "." st) (modify-syntax-entry ?| "." st) - (modify-syntax-entry ?\u00ab "." st) - (modify-syntax-entry ?\u00bb "." st) - (modify-syntax-entry ?\u2018 "." st) - (modify-syntax-entry ?\u2019 "." st) - (modify-syntax-entry ?\u201c "." st) - (modify-syntax-entry ?\u201d "." st) - + (modify-syntax-entry ?« "." st) + (modify-syntax-entry ?» "." st) + (modify-syntax-entry ?‘ "." st) + (modify-syntax-entry ?’ "." st) + (modify-syntax-entry ?“ "." st) + (modify-syntax-entry ?” "." st) st) "Syntax table used while in `rst-mode'.") - (defcustom rst-mode-hook nil "Hook run when `rst-mode' is turned on. The hook for `text-mode' is run before this one." @@ -787,6 +798,8 @@ ;; 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))) @@ -848,6 +861,9 @@ (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. @@ -863,8 +879,11 @@ (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 "Toggle ReST minor mode. @@ -966,7 +985,7 @@ :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) @@ -979,10 +998,10 @@ 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 @@ -1019,8 +1038,8 @@ (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)))) @@ -1076,9 +1095,9 @@ (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 @@ -1255,8 +1274,8 @@ 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 @@ -1310,15 +1329,15 @@ (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) @@ -1487,15 +1506,15 @@ 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). This function is a bit of a swiss knife. It is meant to adjust the adornments of a section title in reStructuredText. It tries -to deal with all the possible cases gracefully and to do `the -right thing' in all cases. +to deal with all the possible cases gracefully and to do \"the +right thing\" in all cases. See the documentations of `rst-adjust-adornment-work' and `rst-promote-region' for full details. @@ -1594,7 +1613,7 @@ 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 @@ -1637,8 +1656,8 @@ 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. @@ -1907,7 +1926,7 @@ 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)) @@ -1916,13 +1935,13 @@ (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 @@ -1936,7 +1955,7 @@ (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) @@ -2005,20 +2024,20 @@ ;; 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 @@ -2120,15 +2139,15 @@ (a) If user selects bullets or #, it's just added. (b) If user selects enumerations, a further prompt is given. User needs to - input a starting item, for example 'e' for 'A)' style. + input a starting item, for example `e' for `A)' style. 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 +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 the problem elegantly in most situations. But when those overlapped list are preceded by a blank line, it is hard to determine which type to use automatically. The function uses alphabetical list by default. If you want @@ -2256,13 +2275,11 @@ "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 -...). +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." +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))) @@ -2295,6 +2312,7 @@ (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) @@ -2302,15 +2320,20 @@ "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) @@ -2323,6 +2346,7 @@ (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) @@ -2362,7 +2386,7 @@ (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 @@ -2418,8 +2442,8 @@ ;; 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 @@ -2589,7 +2613,7 @@ ;; 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 @@ -2660,8 +2684,8 @@ (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. @@ -2826,15 +2850,14 @@ (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 @@ -2844,24 +2867,28 @@ (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) @@ -2931,11 +2958,11 @@ (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. @@ -3095,7 +3122,7 @@ (defun rst-comment-region (beg end &optional arg) "Comment or uncomment the current region. -Region is from from BEG to END. Uncomment if ARG." +Region is from BEG to END. Uncomment if ARG." (save-excursion (if (consp arg) (rst-uncomment-region beg end arg) @@ -3110,7 +3137,7 @@ (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 @@ -3416,7 +3443,7 @@ "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 need levels beyond 6 you have to define faces +adornment). If you need levels beyond 6 you have to define faces of your own." :group 'rst-faces :type '(alist @@ -3545,8 +3572,8 @@ ;; properties on comments and literal blocks so they are *not* ;; inline fontified. See (elisp)Search-based Fontification. - ;; FIXME: And / or use `syntax-propertize` functions as in `octave-mod.el` - ;; and other V24 modes. May make `font-lock-extend-region` + ;; FIXME: And / or use `syntax-propertize' functions as in `octave-mod.el' + ;; and other V24 modes. May make `font-lock-extend-region' ;; superfluous. ;; `Comments`_ @@ -3748,8 +3775,7 @@ (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. @@ -3757,8 +3783,7 @@ 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 @@ -3798,12 +3823,11 @@ (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 @@ -3824,10 +3848,9 @@ (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)) @@ -3849,9 +3872,8 @@ (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. @@ -3866,7 +3888,7 @@ (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 @@ -3927,15 +3949,15 @@ (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`. +;; FIXME: Must be defcustom. (defvar rst-compile-primary-toolset 'html "The default tool-set for `rst-compile'.") -;; FIXME: Must be `defcustom`. +;; FIXME: Must be defcustom. (defvar rst-compile-secondary-toolset 'latex "The default tool-set for `rst-compile' with a prefix argument.") @@ -3963,7 +3985,7 @@ (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 @@ -4014,7 +4036,7 @@ (cadr (assq 'pseudoxml rst-compile-toolsets)) standard-output))) -;; FIXME: Should be `defcustom`. +;; FIXME: Should be defcustom. (defvar rst-pdf-program "xpdf" "Program used to preview PDF files.") @@ -4031,7 +4053,7 @@ ;; output. )) -;; FIXME: Should be `defcustom` or use something like `browse-url`. +;; FIXME: Should be defcustom or use something like `browse-url'. (defvar rst-slides-program "firefox" "Program used to preview S5 slides.") @@ -4068,7 +4090,7 @@ a)) (defun rst-imenu-convert-cell (elt adornments) - "Convert a cell ELT in a tree returned from `rst-section-tree' to imenu index. + "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)) @@ -4102,7 +4124,7 @@ ;; 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. + "Create index for Imenu. Return as described for `imenu--index-alist'." (rst-reset-section-caches) (let ((tree (rst-section-tree)) @@ -4140,7 +4162,7 @@ (let ((width (current-column))) (rst-delete-entire-line) (insert-char tochar width))) - (message (format "%d lines replaced." found))))) + (message "%d lines replaced." found)))) ;; FIXME: Unbound command - should be bound or removed. (defun rst-join-paragraph () @@ -4164,8 +4186,8 @@ ;; 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. @@ -4214,4 +4236,8 @@ (provide 'rst) +;; Local Variables: +;; coding: utf-8 +;; End: + ;;; rst.el ends here Modified: trunk/docutils/tools/editors/emacs/tests/fill.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/fill.el 2015-10-04 08:23:22 UTC (rev 7924) +++ trunk/docutils/tools/editors/emacs/tests/fill.el 2015-10-04 09:21:35 UTC (rev 7925) @@ -463,7 +463,7 @@ Normal text should also fill as expected \^?" - " + "\^@ * This is a test with a fill column of 20 @@ -513,7 +513,7 @@ Normal text should also fill as expected -\^@\^?" +\^?" )) (should (ert-equal-buffer (explicit-fill-region) @@ -537,7 +537,7 @@ Normal text should also fill as expected \^?" - " + "\^@ * This is a test with a fill column of 20 @@ -578,6 +578,6 @@ Normal text should also fill as expected -\^@\^?" +\^?" )) )) Modified: trunk/docutils/tools/editors/emacs/tests/toc.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/toc.el 2015-10-04 08:23:22 UTC (rev 7924) +++ trunk/docutils/tools/editors/emacs/tests/toc.el 2015-10-04 09:21:35 UTC (rev 7925) @@ -150,6 +150,167 @@ ) )) +(defun toc () + "Call `rst-toc' and copy special buffer to target buffer." + (let ((wincfg (current-window-configuration)) + txt pt mrk) + (if (get-buffer rst-toc-buffer-name) + (kill-buffer rst-toc-buffer-name)) + (rst-toc) + (with-current-buffer rst-toc-buffer-name + (setq txt (buffer-substring-no-properties (point-min) (point-max))) + (setq pt (point)) + (setq mrk (mark t))) + (set-window-configuration wincfg) + (kill-buffer rst-toc-buffer-name) + (delete-region (point-min) (point-max)) + (insert txt) + (set-mark mrk) + (goto-char pt))) + +(ert-deftest rst-toc () + "Tests `rst-toc'." + ;; Set customizable variables to defaults + (let ((rst-toc-indent 2)) + (should (ert-equal-buffer + (toc) + "===== +Title +===== + +Header A +======== + +Header B +======== + +Subheader B.a +------------- + +SubSubheader B.a.1 +~~~~~~~~~~~~~~~~~~ + +Subheader B.b +------------- + +Header C +======== +\^@" + "Table of Contents: +Title + Header A + Header B + Subheader B.a + SubSubheader B.a.1 + Subheader B.b +\^@ Header C +" + )) + (should (ert-equal-buffer + (toc) + "===== +Title +===== + +Header A +======== + +Header B +======== + +Subh\^@eader B.a +------------- + +SubSubheader B.a.1 +~~~~~~~~~~~~~~~~~~ + +Subheader B.b +------------- + +Header C +======== +" + "Table of Contents: +Title + Header A + Header B +\^@ Subheader B.a + SubSubheader B.a.1 + Subheader B.b + Header C +" + )) + (should (ert-equal-buffer + (toc) + "\^@ + +===== +Title +===== + +Header A +======== + +Header B +======== + +Subheader B.a +------------- + +SubSubheader B.a.1 +~~~~~~~~~~~~~~~~~~ + +Subheader B.b +------------- + +Header C +======== +" + "\^@Table of Contents: +Title + Header A + Header B + Subheader B.a + SubSubheader B.a.1 + Subheader B.b + Header C +" + )) + (should (ert-equal-buffer + (toc) + "===== +Title +===== + +Header A +======== + +Header B +======== + +Subheader B.a +------------- + +SubSubheader B.a.1 +~~~~~~~~~~~~~~~~~~ +\^@ +Subheader B.b +------------- + +Header C +======== +" + "Table of Contents: +Title + Header A + Header B + Subheader B.a +\^@ SubSubheader B.a.1 + Subheader B.b + Header C +" + )) + )) + ;; FIXME: More functions to test: -;; * rst-toc ;; * rst-toc-mode-goto-section This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <sm...@us...> - 2015-12-28 22:49:48
|
Revision: 7931 http://sourceforge.net/p/docutils/code/7931 Author: smerten Date: 2015-12-28 22:49:45 +0000 (Mon, 28 Dec 2015) Log Message: ----------- Replaced macros `rst-iterate-leftmost-...` by new function `rst-apply-indented-blocks`. Refactored `rst-enumerate-region`, `rst-bullet-list-region` and `rst-line-block-region` to use `rst-apply-indented-blocks`. Improved `rst-enumerate-region` and `rst-bullet-list-region` to not indent empty lines and not indent lines before indented block. Debugged those commands to not run into endless loops on blocks at the end of a buffer missing a final newline. Improved `rst-line-block-region` to not kill indentation. Modified Paths: -------------- trunk/docutils/tools/editors/emacs/rst.el Added Paths: ----------- trunk/docutils/tools/editors/emacs/tests/apply-block.el Modified: trunk/docutils/tools/editors/emacs/rst.el =================================================================== --- trunk/docutils/tools/editors/emacs/rst.el 2015-12-08 19:45:01 UTC (rev 7930) +++ trunk/docutils/tools/editors/emacs/rst.el 2015-12-28 22:49:45 UTC (rev 7931) @@ -218,7 +218,7 @@ ;; 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.327.2.24 2015/10/04 09:08:14 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.30 2015/12/28 22:43:38 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -243,7 +243,7 @@ ;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.4.1 %") + "%OfficialVersion: 1.4.2 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " @@ -268,6 +268,7 @@ ("1.3.1" . "24.3") ("1.4.0" . "24.3") ("1.4.1" . "24.5") + ("1.4.2" . "24.5") )) (unless (assoc rst-official-version rst-package-emacs-version-alist) @@ -2751,11 +2752,13 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Functions to work on item lists (e.g. indent/dedent, enumerate), which are -;; always 2 or 3 characters apart horizontally with rest. +;; Indentation (defun rst-find-leftmost-column (beg end) - "Return the leftmost column in region BEG to END." + "Return the leftmost column spanned by region BEG to END. +The line containing the start of the region is always considered +spanned. If the region ends at the beginning of a line this line +is not considered spanned, otherwise it is spanned." (let (mincol) (save-excursion (goto-char beg) @@ -2768,80 +2771,6 @@ (forward-line 1))) mincol)) -;; FIXME: This definition is old and deprecated. We need to move to the newer -;; version below. -(defmacro rst-iterate-leftmost-paragraphs - (beg end first-only body-consequent body-alternative) - ;; FIXME: The following comment is pretty useless. - "Call FUN at the beginning of each line, with an argument that -specifies whether we are at the first line of a paragraph that -starts at the leftmost column of the given region BEG and END. -Set FIRST-ONLY to true if you want to callback on the first line -of each paragraph only." - `(save-excursion - (let ((leftcol (rst-find-leftmost-column ,beg ,end)) - (endm (copy-marker ,end))) - - (do* (;; Iterate lines. - (l (progn (goto-char ,beg) (back-to-indentation)) - (progn (forward-line 1) (back-to-indentation))) - - (previous nil valid) - - (curcol (current-column) - (current-column)) - - (valid (and (= curcol leftcol) - (not (looking-at (rst-re 'lin-end)))) - (and (= curcol leftcol) - (not (looking-at (rst-re 'lin-end)))))) - ((>= (point) endm)) - - (if (if ,first-only - (and valid (not previous)) - valid) - ,body-consequent - ,body-alternative))))) - -;; FIXME: This needs to be refactored. Probably this is simply a function -;; applying BODY rather than a macro. -(defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body) - "Evaluate BODY for each line in region defined by BEG END. -LEFTMOST is set to true if the line is one of the leftmost of the -entire paragraph. PARABEGIN is set to true if the line is the -first of a paragraph." - (declare (indent 1) (debug (sexp body))) - (destructuring-bind - (beg end parabegin leftmost isleftmost isempty) spec - - `(save-excursion - (let ((,leftmost (rst-find-leftmost-column ,beg ,end)) - (endm (copy-marker ,end))) - - (do* (;; Iterate lines. - (l (progn (goto-char ,beg) (back-to-indentation)) - (progn (forward-line 1) (back-to-indentation))) - - (empty-line-previous nil ,isempty) - - (,isempty (looking-at (rst-re 'lin-end)) - (looking-at (rst-re 'lin-end))) - - (,parabegin (not ,isempty) - (and empty-line-previous - (not ,isempty))) - - (,isleftmost (and (not ,isempty) - (= (current-column) ,leftmost)) - (and (not ,isempty) - (= (current-column) ,leftmost)))) - ((>= (point) endm)) - - (progn ,@body)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Indentation - ;; FIXME: At the moment only block comments with leading empty comment line are ;; supported. Comment lines with leading comment markup should be also ;; supported. May be a customizable option could control which style to @@ -3150,7 +3079,8 @@ (indent-rigidly eol end (- rst-indent-comment)) (delete-region bol eol)))) -;;------------------------------------------------------------------------------ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Apply to indented block ;; FIXME: These next functions should become part of a larger effort to redo ;; the bullets in bulleted lists. The enumerate would just be one of @@ -3158,29 +3088,127 @@ ;; ;; FIXME: We need to do the enumeration removal as well. +(defun rst-apply-indented-blocks (beg end ind fun) + "Apply FUN to all lines from BEG to END in blocks indented to IND. +The first indented block starts with the first non-empty line +containing or after BEG and indented to IND. After the first +line the indented block may contain more lines with same +indentation (the paragraph) followed by empty lines and lines +more indented (the sub-blocks). A following line indented to IND +starts the next indented block. A line with less indentation +than IND terminates the current indented block. Such lines and +all following lines not indented to IND are skipped. FUN is +applied to unskipped lines like this + + (FUN COUNT FIRSTP SUBP EMPTYP RELIND LASTRET) + +COUNT is 0 before the first indented block and increments for +every indented block found. + +FIRSTP is t when this is the first line of the paragraph. + +SUBP is t when this line is part of a sub-block. + +EMPTYP is t when this line is empty. + +RELIND is nil for an empty line, 0 for a line indented to IND, +and the number of columns more indented otherwise. + +LASTRET is the return value of FUN returned by the last +invocation for the same indented block or nil for the first +invocation. + +When FUN is called point is immediately behind indentation of +that line. FUN may change everything as long as a marker at END +is handled correctly by the change. + +Return the return value of the last invocation of FUN or nil if +FUN was never called." + (let (lastret + subp + skipping + nextm + (count 0) ; Before first indented block + (endm (copy-marker end t))) + (save-excursion + (goto-char beg) + (while (< (point) endm) + (save-excursion + (setq nextm (save-excursion + (forward-line 1) + (copy-marker (point) t))) + (back-to-indentation) + (let (firstp + emptyp + (relind (- (current-column) ind))) + (cond + ((looking-at (rst-re 'lin-end)) + (setq emptyp t) + (setq relind nil) + ;; Breaks indented block if one is started + (setq subp (not (zerop count)))) + ((< relind 0) ; Less indented + (setq skipping t)) + ((zerop relind) ; In indented block + (when (or subp skipping (zerop count)) + (setq firstp t) + (incf count)) + (setq subp nil) + (setq skipping nil)) + (t ; More indented + (setq subp t))) + (unless skipping + (setq lastret + (funcall fun count firstp subp emptyp relind lastret))))) + (goto-char nextm)) + lastret))) + (defun rst-enumerate-region (beg end all) "Add enumeration to all the leftmost paragraphs in the given region. The region is specified between BEG and END. With ALL, do all lines instead of just paragraphs." (interactive "r\nP") - (let ((count 0) - (last-insert-len nil)) - (rst-iterate-leftmost-paragraphs - beg end (not all) - (let ((ins-string (format "%d. " (incf count)))) - (setq last-insert-len (length ins-string)) - (insert ins-string)) - (insert (make-string last-insert-len ?\ ))))) + (let ((enum 0)) + (rst-apply-indented-blocks + beg end (rst-find-leftmost-column beg end) + (lambda (count firstp subp emptyp relind lastret) + (cond + (emptyp) + ((zerop count)) + (subp + (insert lastret)) + ((or firstp all) + (let ((ins (format "%d. " (incf enum)))) + (setq lastret (make-string (length ins) ?\ )) + (insert ins))) + (t + (insert lastret))) + lastret)))) +;; FIXME: Does not deal with deeper indentation - although +;; `rst-apply-indented-blocks' could. (defun rst-bullet-list-region (beg end all) "Add bullets to all the leftmost paragraphs in the given region. The region is specified between BEG and END. With ALL, do all lines instead of just paragraphs." (interactive "r\nP") - (rst-iterate-leftmost-paragraphs - beg end (not all) - (insert (car rst-preferred-bullets) " ") - (insert " "))) + (unless rst-preferred-bullets + (error "No preferred bullets defined")) + (let ((bul (format "%c " (car rst-preferred-bullets))) + (cont " ")) + (rst-apply-indented-blocks + beg end (rst-find-leftmost-column beg end) + (lambda (count firstp subp emptyp relind lastret) + (cond + (emptyp) + ((zerop count)) + (subp + (insert cont)) + ((or firstp all) + (insert bul)) + (t + (insert cont))) + nil)))) ;; FIXME: Does not deal with a varying number of digits appropriately. ;; FIXME: Does not deal with multiple levels independently. @@ -3203,25 +3231,18 @@ (replace-match (format "%d." count) nil nil nil 1) (incf count))))) -;;------------------------------------------------------------------------------ - -(defun rst-line-block-region (rbeg rend &optional pfxarg) - "Toggle line block prefixes for a region. -Region is from RBEG to REND. With PFXARG set the empty lines too." +(defun rst-line-block-region (beg end &optional with-empty) + "Add line block prefixes for a region. +Region is from BEG to END. With WITH-EMPTY prefix empty lines too." (interactive "r\nP") - (let ((comment-start "| ") - (comment-end "") - (comment-start-skip "| ") - (comment-style 'indent) - (force (not (not pfxarg)))) - (rst-iterate-leftmost-paragraphs-2 - (rbeg rend parbegin leftmost isleft isempty) - (when (or force (not isempty)) - (move-to-column leftmost force) - (delete-region (point) (+ (point) (- (current-indentation) leftmost))) - (insert "| "))))) + (let ((ind (rst-find-leftmost-column beg end))) + (rst-apply-indented-blocks + beg end ind + (lambda (count firstp subp emptyp relind lastret) + (when (or with-empty (not emptyp)) + (move-to-column ind t) + (insert "| ")))))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Font lock @@ -4236,8 +4257,4 @@ (provide 'rst) -;; Local Variables: -;; coding: utf-8 -;; End: - ;;; rst.el ends here Added: trunk/docutils/tools/editors/emacs/tests/apply-block.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/apply-block.el (rev 0) +++ trunk/docutils/tools/editors/emacs/tests/apply-block.el 2015-12-28 22:49:45 UTC (rev 7931) @@ -0,0 +1,495 @@ +;; Tests for various functions around applying a function to an indented block + +(add-to-list 'load-path ".") +(load "init" nil t) +(init-rst-ert t) + +(ert-deftest apply-block-asserts () + "Check some assertions." + (should (equal ert-Buf-point-char "\^@")) + (should (equal ert-Buf-mark-char "\^?")) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun find-leftmost-column () + "Call `rst-find-leftmost-column' with current region." + (rst-find-leftmost-column (region-beginning) (region-end))) + +(ert-deftest rst-find-leftmost-column () + "Tests for `rst-find-leftmost-column'." + (should (ert-equal-buffer-return + (find-leftmost-column) + "\^@abc +\^?" + t + 0)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " +\^@abc +\^?" + t + 0)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " +\^@ abc +\^?" + t + 2)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " +\^@ abc +def +\^?" + t + 0)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " +\^@ abc + def +\^?" + t + 2)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " +\^@ abc + def +\^?" + t + 4)) + (should (ert-equal-buffer-return + (find-leftmost-column) + ; Empty lines contain spaces + " +\^@ + + abc + + def + +\^?" + t + 4)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " abc\^@ +def\^?" + t + 0)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " + abc\^@ + def +\^?" + t + 2)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " a\^@b\^?c +def" + t + 2)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " +\^@ abc +\^? def +" + t + 4)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " +\^@ abc + \^? def +" + t + 2)) + (should (ert-equal-buffer-return + (find-leftmost-column) + " +\^@ abc + d\^?ef +" + t + 2)) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun bullet-list-region (all) + "Call `rst-bullet-list-region' with current region and ALL." + (rst-bullet-list-region (region-beginning) (region-end) all)) + +(ert-deftest rst-bullet-list-region () + "Tests for `rst-bullet-list-region'." + (let ((rst-preferred-bullets '(?*))) + (should (ert-equal-buffer + (bullet-list-region nil) + " +\^@ +eins +one + +zwei +two +\^?" + " +\^@ +* eins + one + +* zwei + two +\^?")) + (should (ert-equal-buffer + (bullet-list-region nil) + " +\^@ +eins +one + + intermediate + +zwei +two +\^?" + " +\^@ +* eins + one + + intermediate + +* zwei + two +\^?")) + (should (ert-equal-buffer + (bullet-list-region nil) + " +\^@ +eins +one + +zwei +two\^?" + " +\^@ +* eins + one + +* zwei + two\^?")) + (should (ert-equal-buffer + (bullet-list-region t) + " +\^@ +eins +zwei + +drei + + vier +\^?" + " +\^@ +* eins +* zwei + +* drei + + vier +\^?")) + )) + +(ert-deftest rst-bullet-list-region-error () + "Tests for `rst-bullet-list-region' ending in an error." + (let ((rst-preferred-bullets nil)) + (should-error (ert-equal-buffer + (bullet-list-region nil) + "" + t + ) + :type 'error) + )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun enumerate-region (all) + "Call `rst-enumerate-region' with current region and ALL." + (rst-enumerate-region (region-beginning) (region-end) all)) + +(ert-deftest rst-enumerate-region () + "Tests for `rst-enumerate-region'." + (should (ert-equal-buffer + (enumerate-region nil) + " +\^@eins +one + +zwei +two +\^?" + " +\^@1. eins + one + +2. zwei + two +\^?")) + (should (ert-equal-buffer + (enumerate-region nil) + " +\^@eins +one + + intermediate + +zwei +two +\^?" + " +\^@1. eins + one + + intermediate + +2. zwei + two +\^?")) + (should (ert-equal-buffer + (enumerate-region t) + " +\^@eins +zwei + +drei +\^?" + " +\^@1. eins +2. zwei + +3. drei +\^?")) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun line-block-region (empty) + "Call `rst-line-block-region' with current region and EMPTY." + (rst-line-block-region (region-beginning) (region-end) empty)) + +(ert-deftest rst-line-block-region () + "Tests for `rst-line-block-region'." + (should (ert-equal-buffer + (line-block-region nil) + " +\^@ +eins +one + +zwei +\^?" + " +\^@ +| eins +| one + +| zwei +\^?")) + (should (ert-equal-buffer + (line-block-region nil) + " +\^@ +eins + one + +zwei + two +\^?" + " +\^@ +| eins +| one + +| zwei +| two +\^?")) + (should (ert-equal-buffer + (line-block-region nil) + " +\^@ + eins + one + + zwei + two +\^?" + " +\^@ + | eins + | one + + | zwei + | two +\^?")) + (should (ert-equal-buffer + (line-block-region t) + " +\^@ +eins +one + +zwei +\^?" + " +\^@| +| eins +| one +| +| zwei +\^?")) + (should (ert-equal-buffer + (line-block-region t) + " +\^@ +eins + one + +zwei +\^?" + " +\^@| +| eins +| one +| +| zwei +\^?")) + (should (ert-equal-buffer + (line-block-region t) + " +\^@ + eins + one + + zwei +\^?" + " +\^@ | + | eins + | one + | + | zwei +\^?")) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun indented-block-params (count firstp subp emptyp relind lastret) + "Return LASTRET appended by a list of current column and the other parameters." + (append lastret + (list (list (current-column) count firstp subp emptyp relind)))) + +(defun apply-indented-blocks (ind fun) + "Call `rst-apply-indented-blocks' on current region with IND and FUN." + (rst-apply-indented-blocks (region-beginning) (region-end) ind fun)) + +(ert-deftest rst-apply-indented-blocks () + "Tests for `rst-apply-indented-blocks'." + (should (ert-equal-buffer-return + (apply-indented-blocks 0 indented-block-params) + "\^@abc +\^?" + t + '((0 1 t nil nil 0) + ))) + (should (ert-equal-buffer-return + (apply-indented-blocks 0 indented-block-params) + "a\^@b\^?c" + t + '((0 1 t nil nil 0) + ))) + (should (ert-equal-buffer-return + (apply-indented-blocks 2 indented-block-params) + "\^@ + abc +\^?" + t + '((2 0 nil nil t nil) + (2 1 t nil nil 0) + ))) + (should (ert-equal-buffer-return + (apply-indented-blocks 2 indented-block-params) + "\^@ + abc + + def +\^?" + t + '((0 0 nil nil t nil) + (2 1 t nil nil 0) + (0 1 nil t t nil) + (4 1 nil t nil 2) + ))) + (should (ert-equal-buffer-return + (apply-indented-blocks 2 indented-block-params) + "\^@ + abc + + def + ghi + +\^?" + t + '((0 0 nil nil t nil) + (2 1 t nil nil 0) + (0 1 nil t t nil) + (4 1 nil t nil 2) + (6 1 nil t nil 4) + (2 1 nil t t nil) + ))) + (should (ert-equal-buffer-return + (apply-indented-blocks 0 indented-block-params) + "\^@\^?abc" + t + nil)) + (should (ert-equal-buffer-return + (apply-indented-blocks 2 indented-block-params) + "\^@ + abc + + def + ghi +\^?" + t + '((0 0 nil nil t nil) + (2 1 t nil nil 0) + (0 1 nil t t nil) + (2 2 t nil nil 0) + (4 2 nil t nil 2) + ))) + (should (ert-equal-buffer-return + (apply-indented-blocks 2 indented-block-params) + "\^@ + abc + +def + + ghi + jkl + mno +\^?" + t + '((0 0 nil nil t nil) + (2 1 t nil nil 0) + (0 1 nil t t nil) + (2 2 t nil nil 0) + (2 2 nil nil nil 0) + ))) + ) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <sm...@us...> - 2016-07-31 11:13:25
|
Revision: 7963 http://sourceforge.net/p/docutils/code/7963 Author: smerten Date: 2016-07-31 11:13:21 +0000 (Sun, 31 Jul 2016) Log Message: ----------- Major refactoring: * Introduce classes `rst-Ado', `rst-Hdr', `rst-Ttl' and `rst-Stn' representing reStructuredText section header concepts. * Introduce use case approach for systematic testing of section header adjustment (files `tests/adjust-uc.el` and `tests/adjust-uc_doc.rst`). * Revise and refactor some old code. * Add lots of unit tests. * Replace `set (make-local-variable 'VAR)` by `setq-local VAR`. * Fix minor bugs. Minor feature changes and fixes: * Link final newline in a toc buffer so navigating at the end of the line works. * Improve section header adjustment slightly. * Integrate and update tutorial. Modified Paths: -------------- trunk/docutils/tools/editors/emacs/IDEAS.rst trunk/docutils/tools/editors/emacs/rst.el trunk/docutils/tools/editors/emacs/tests/adjust-section.el trunk/docutils/tools/editors/emacs/tests/adornment.el trunk/docutils/tools/editors/emacs/tests/apply-block.el trunk/docutils/tools/editors/emacs/tests/buffer.el trunk/docutils/tools/editors/emacs/tests/cl.el trunk/docutils/tools/editors/emacs/tests/comment.el trunk/docutils/tools/editors/emacs/tests/ert-buffer.el trunk/docutils/tools/editors/emacs/tests/fill.el trunk/docutils/tools/editors/emacs/tests/font-lock.el trunk/docutils/tools/editors/emacs/tests/imenu.el trunk/docutils/tools/editors/emacs/tests/indent.el trunk/docutils/tools/editors/emacs/tests/items.el trunk/docutils/tools/editors/emacs/tests/movement.el trunk/docutils/tools/editors/emacs/tests/shift.el trunk/docutils/tools/editors/emacs/tests/toc.el trunk/docutils/tools/editors/emacs/tests/tree.el Added Paths: ----------- trunk/docutils/tools/editors/emacs/tests/Ado.el trunk/docutils/tools/editors/emacs/tests/Hdr.el trunk/docutils/tools/editors/emacs/tests/Stn.el trunk/docutils/tools/editors/emacs/tests/Ttl.el trunk/docutils/tools/editors/emacs/tests/adjust-uc.el trunk/docutils/tools/editors/emacs/tests/adjust-uc_doc.rst Modified: trunk/docutils/tools/editors/emacs/IDEAS.rst =================================================================== --- trunk/docutils/tools/editors/emacs/IDEAS.rst 2016-07-30 22:05:13 UTC (rev 7962) +++ trunk/docutils/tools/editors/emacs/IDEAS.rst 2016-07-31 11:13:21 UTC (rev 7963) @@ -228,8 +228,6 @@ * Tables - * Section headers - * Link definitions * May be `fill-nobreak-predicate` can help here, too @@ -247,6 +245,8 @@ * See `Sophisticated indentation`_ +* See also `Filling of section headers`_ + Sophisticated indentation ========================= @@ -472,3 +472,199 @@ :Even longer name: More aligned * See `align.el` + +toc-mode per buffer +=================== + +* At the moment there can only be globally one TOC + + * A TOC could be separate for each buffer + +toc-mode could generate reST +============================ + +* The format of the generated TOC could be reStructuredText + + * For instance as a bullet list + + * So it could be copied and basted into a reStructuredText document + + * Conversion could be done in toc-mode buffer + +* An alternative could be that `rst-bullet-list-region` handles + indented text properly + +Improvements for comments +========================= + +* `comment-use-syntax` should be set to nil locally + +* `comment-forward` should work so `comment-dwim` recognizes a + commented region + + * Then it could uncomment it automatically and use of prefix + argument is no longer neccessary + +Context sensitive M-q +===================== + +* M-q / `fill-paragraph` should check whether point is in section + header and call `rst-adjust` in this case + + * This would unify handling of changes in section headers and normal + paragraphs + +Switch to using `cl-lib` +======================== + +* Options to use `cl-lib` + + There are various options, and you'll have to judge for yourself which + is best for your particular case: + - live with the warnings. + - switch to cl-lib and ask users of older Emacsen to install cl-lib + (available in GNU ELPA). + - add things like (unless (fboundp 'cl-letf) (defalias 'cl-letf 'letf)). + - change the code to use something else (e.g. for flet, you can switch + to using either defadvice or (let ((f1 (lambda ..))) ...). + - ... + + -- Stefan Monnier + +* Remove own implementations then + +Filling of section headers +========================== + +* Filling should recognize section headers and adjust the adornment + + * Then a fill operation for a region wouldn't break the section + header adornment + + * In addition a fill operation could be used instead of adjusting a + section header + +Cursor after adjusting adornment +================================ + +* Adjusting a section header should move the cursor to the end of the + adornment + + * Then a following C-j / Return opens a new line instead of breaking + the adornment just created + +Copying literal blocks +====================== + +* Copying literal blocks should eat up the block indentation + + * This way code fragments can be copied without removing the block + indentation by hand + +Structural operations for toc-mode +================================== + +* Structrual operations for toc-mode + + * Raise or lower sections + + * Move sections around + +Inhibit auto-fill in literal blocks +=================================== + +* In a literal block a space should not do auto-fill + + * May be variable `normal-auto-fill-function` can be set mode + specific + + * Is normally `do-auto-fill` + +toc-mode should leave mark +========================== + +* When you jump to a different point in the document by using toc-mode + the mark should be set at the point of departure + + * This aligns with the semantic of other far jumps in the document + such as `beginning-of-buffer` + +Remembering last location per section +===================================== + +* Remembering the last location per section would make it possible to + jump back to this location + + * This is useful if several sections are worked on in parallel + +* The jump into the section could happen from toc-mode + + * Instead of to the section header + + * May be by a special key + +* Other section based jump commands could do similar + + * For instance navigating by sections + +* This calls for a general modifier for jumps + +Multiple steps for `rst-adjust` +=============================== + +* Sometimes it's useful to adjust more than one step in the given + direction + + * For instance to follow a 2= title by 1= normal header skipping the + usual 2- level + +* Therefore using a counter may be useful + +Enhance compilation support +=========================== + +* Compilation to ODT should be supported + +* Arbitrary compilations should be supported using customization + + * Key must be configurable + + * Command must be configurable + +* May be the whole toolset stuff needs to be replaced? + +Support for longlines mode +========================== + +* `longlines-mode` should use correct indentation for broken lines + + * This is actually an enhancement of `longlines-mode` + + * `longlines-mode` modifies the buffer + + * This is needed to use all the standard functionality like + `move-to-column` + + * Using property `display` for inserting indentation does not work + properly because of this + + * Indentation must be inserted in the buffer + + * However, it needs to have the property `intangible` so it can + not be modified + + * See `Emacs Lisp => 32.19 Text Properties => Special + Properties` + + * It would be nice to also have a visible indication for being + automatic insertion + + * Such indentation must be removed by `longlines-encode-*` + + * Probably it should be marked by a special property such as + `longlines-indentation` + + * `longlines-wrap-line` needs a hook called after replacing the + blank by a soft newline + + * May be `longlines-*search-*` needs to be adapted as well? Modified: trunk/docutils/tools/editors/emacs/rst.el =================================================================== --- trunk/docutils/tools/editors/emacs/rst.el 2016-07-30 22:05:13 UTC (rev 7962) +++ trunk/docutils/tools/editors/emacs/rst.el 2016-07-31 11:13:21 UTC (rev 7963) @@ -1,9 +1,9 @@ ;;; rst.el --- Mode for viewing and editing reStructuredText-documents. -;; Copyright (C) 2003-2015 Free Software Foundation, Inc. +;; Copyright (C) 2003-2016 Free Software Foundation, Inc. -;; Maintainer: Stefan Merten <sm...@oe...> -;; Author: Stefan Merten <sm...@oe...>, +;; Maintainer: Stefan Merten <stefan at merten-home dot de> +;; Author: Stefan Merten <stefan at merten-home dot de>, ;; Martin Blais <bl...@fu...>, ;; David Goodger <go...@py...>, ;; Wei-Wei Guo <ww...@gm...> @@ -53,11 +53,11 @@ ;; For full details on how to use the contents of this file, see ;; http://docutils.sourceforge.net/docs/user/emacs.html ;; +;; There are a number of convenient key bindings provided by rst-mode. For the +;; bindings, try C-c C-h when in rst-mode. There are also many variables that +;; can be customized, look for defcustom in this file or look for the "rst" +;; customization group contained in the "wp" group. ;; -;; There are a number of convenient key bindings provided by rst-mode. -;; For more on bindings, see rst-mode-map below. There are also many variables -;; that can be customized, look for defcustom in this file. -;; ;; If you use the table-of-contents feature, you may want to add a hook to ;; update the TOC automatically every time you adjust a section title:: ;; @@ -68,11 +68,6 @@ ;; ;; (setq font-lock-global-modes '(not rst-mode ...)) ;; -;; -;; -;; Customization is done by customizable variables contained in customization -;; group "rst" and subgroups. Group "rst" is contained in the "wp" group. -;; ;;; DOWNLOAD @@ -110,10 +105,10 @@ ;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*- ;; lexical-binding: t -*-" in the first line. -;; FIXME: Use `testcover'. +;; FIXME: Embed complicated `defconst's in `eval-when-compile'. -;; FIXME: The adornment classification often called `ado' should be a -;; `defstruct'. +;; FIXME: Use `testcover'. Mark up a function with sufficient test coverage by +;; a comment tagged with `testcover' after the `defun'. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for `testcover' @@ -160,6 +155,7 @@ ;; used from there. (defun rst-signum (x) + ;; testcover: ok. "Return 1 if X is positive, -1 if negative, 0 if zero." (cond ((> x 0) 1) @@ -167,6 +163,7 @@ (t 0))) (defun rst-some (seq &optional pred) + ;; testcover: ok. "Return non-nil if any element of SEQ yields non-nil when PRED is applied. Apply PRED to each element of list SEQ until the first non-nil result is yielded and return this result. PRED defaults to @@ -180,6 +177,7 @@ (throw 'rst-some r)))))) (defun rst-position-if (pred seq) + ;; testcover: ok. "Return position of first element satisfying PRED in list SEQ or nil." (catch 'rst-position-if (let ((i 0)) @@ -189,6 +187,7 @@ (incf i))))) (defun rst-position (elem seq) + ;; testcover: ok. "Return position of ELEM in list SEQ or nil. Comparison done with `equal'." ;; Create a closure containing `elem' so the `lambda' always sees our @@ -199,13 +198,22 @@ (equal elem e))) seq))) -;; FIXME: Embed complicated `defconst's in `eval-when-compile'. +(defun rst-member-if (pred seq) + ;; testcover: ok. + "Return sublist of SEQ starting with the element whose car satisfies PRED." + (let (found) + (while (and (not found) seq) + (if (funcall pred (car seq)) + (setq found seq) + (setq seq (cdr seq)))) + found)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Versions -;; testcover: ok. (defun rst-extract-version (delim-re head-re re tail-re var &optional default) + ;; testcover: ok. "Extract the version from a variable according to the given regexes. Return the version after regex DELIM-RE and HEAD-RE matching RE and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." @@ -218,7 +226,7 @@ ;; 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.327.2.30 2015/12/28 22:43:38 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.599 2016/07/31 11:13:12 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -243,7 +251,7 @@ ;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.4.2 %") + "%OfficialVersion: 1.5.0 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " @@ -269,6 +277,7 @@ ("1.4.0" . "24.3") ("1.4.1" . "24.5") ("1.4.2" . "24.5") + ("1.5.0" . "25.2") )) (unless (assoc rst-official-version rst-package-emacs-version-alist) @@ -278,10 +287,10 @@ (add-to-list 'customize-package-emacs-version-alist (cons 'ReST rst-package-emacs-version-alist)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Initialize customization - (defgroup rst nil "Support for reStructuredText documents." :group 'wp :version "23.1" @@ -491,8 +500,10 @@ ; character. ;; Titles (`ttl') - (ttl-tag "\\S *\\w\\S *") ; A title text. - (ttl-beg lin-beg ttl-tag) ; A title text at the beginning of a line. + (ttl-tag "\\S *\\w.*\\S ") ; A title text. + (ttl-beg-1 lin-beg (:grp ttl-tag)) ; A title text at the beginning of a + ; line. First group is the complete, + ; trimmed title text. ;; Directives and substitution definitions (`dir') (dir-tag-3 (:grp exm-sta) @@ -532,8 +543,8 @@ ;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel. (rst-testcover-add-compose 'rst-re) -;; testcover: ok. (defun rst-re (&rest args) + ;; testcover: ok. "Interpret ARGS as regular expressions and return a regex string. Each element of ARGS may be one of the following: @@ -604,10 +615,579 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Concepts + +;; Each of the following classes represents an own concept. The suffix of the +;; class name is used in the code to represent entities of the respective +;; class. +;; +;; In addition a reStructuredText section header in the buffer is called +;; "section". +;; +;; For lists a "s" is added to the name of the concepts. + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Ado + +(defstruct + (rst-Ado + (:constructor nil) ;; Prevent creating unchecked values. + ;; Construct a transition. + (:constructor + rst-Ado-new-transition + (&aux + (char nil) + (-style 'transition))) + ;; Construct a simple section header. + (:constructor + rst-Ado-new-simple + (char-arg + &aux + (char (rst-Ado--validate-char char-arg)) + (-style 'simple))) + ;; Construct a over-and-under section header. + (:constructor + rst-Ado-new-over-and-under + (char-arg + &aux + (char (rst-Ado--validate-char char-arg)) + (-style 'over-and-under))) + ;; Construct from adornment with inverted style. + (:constructor + rst-Ado-new-invert + (ado-arg + &aux + (char (rst-Ado-char ado-arg)) + (-style (let ((sty (rst-Ado--style ado-arg))) + (cond + ((eq sty 'simple) + 'over-and-under) + ((eq sty 'over-and-under) + 'simple) + (sty))))))) + "Representation of a reStructuredText adornment. +Adornments are either section markers where they markup the +section header or transitions. + +This type is immutable." + ;; The character used for the adornment. + (char nil :read-only t) + ;; The style of the adornment. This is a private attribute. + (-style nil :read-only t)) + +;; Private class methods + +(defun rst-Ado--validate-char (char) + ;; testcover: ok. + "Validate CHAR to be a valid adornment character. +Return CHAR if so or signal an error otherwise." + (cond + ((not (characterp char)) + (signal 'wrong-type-argument (list 'characterp char))) + ((memq char rst-adornment-chars) + char) + (t + (signal 'args-out-of-range + (list (format + "Character must be a valid adornment character, not '%s'" + char)))))) + +;; Public methods + +(defun rst-Ado-is-transition (self) + ;; testcover: ok. + "Return non-nil if SELF is a transition adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (eq (rst-Ado--style self) 'transition)) + +(defun rst-Ado-is-section (self) + ;; testcover: ok. + "Return non-nil if SELF is a section adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (not (rst-Ado-is-transition self))) + +(defun rst-Ado-is-simple (self) + ;; testcover: ok. + "Return non-nil if SELF is a simple section adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (eq (rst-Ado--style self) 'simple)) + +(defun rst-Ado-is-over-and-under (self) + ;; testcover: ok. + "Return non-nil if SELF is a over-and-under section adornment." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (eq (rst-Ado--style self) 'over-and-under)) + +(defun rst-Ado-equal (self other) + ;; testcover: ok. + "Return non-nil when SELF and OTHER are equal." + (cond + ((not (rst-Ado-p self)) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + ((not (rst-Ado-p other)) + (signal 'wrong-type-argument + (list 'rst-Ado-p other))) + ((not (eq (rst-Ado--style self) (rst-Ado--style other))) + nil) + ((rst-Ado-is-transition self)) + ((equal (rst-Ado-char self) (rst-Ado-char other))))) + +(defun rst-Ado-position (self ados) + ;; testcover: ok. + "Return position of of SELF in ADOS or nil." + (unless (rst-Ado-p self) + (signal 'wrong-type-argument + (list 'rst-Ado-p self))) + (lexical-let ((ado self)) ;; Create closure. + (rst-position-if (function (lambda (e) + (rst-Ado-equal ado e))) + ados))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Hdr + +(defstruct + (rst-Hdr + (:constructor nil) ;; Prevent creating unchecked values. + ;; Construct while all parameters must be valid. + (:constructor + rst-Hdr-new + (ado-arg + indent-arg + &aux + (ado (rst-Hdr--validate-ado ado-arg)) + (indent (rst-Hdr--validate-indent indent-arg ado nil)))) + ;; Construct while all parameters but `indent' must be valid. + (:constructor + rst-Hdr-new-lax + (ado-arg + indent-arg + &aux + (ado (rst-Hdr--validate-ado ado-arg)) + (indent (rst-Hdr--validate-indent indent-arg ado t)))) + ;; Construct a header with same characteristics but opposite style as `ado'. + (:constructor + rst-Hdr-new-invert + (ado-arg + indent-arg + &aux + (ado (rst-Hdr--validate-ado (rst-Ado-new-invert ado-arg))) + (indent (rst-Hdr--validate-indent indent-arg ado t)))) + (:copier rst-Hdr-copy)) ;; Not really needed for an immutable type. + "Representation of reStructuredText section header characteristics. + +This type is immutable." + ;; The adornment of the header. + (ado nil :read-only t) + ;; The indentation of a title text or nil if not given. + (indent nil :read-only t)) + +;; Private class methods + +(defun rst-Hdr--validate-indent (indent ado lax) + ;; testcover: ok. + "Validate INDENT to be a valid indentation for ADO. +Return INDENT if so or signal an error otherwise. If LAX don't +signal an error and return a valid indent." + (cond + ((not (integerp indent)) + (signal 'wrong-type-argument + (list 'integerp 'null indent))) + ((zerop indent) + indent) + ((rst-Ado-is-simple ado) + (if lax + 0 + (signal 'args-out-of-range + '("Indentation must be 0 for style simple")))) + ((< indent 0) + (if lax + 0 + (signal 'args-out-of-range + '("Indentation must not be negative")))) + (indent))) ;; Implicitly over-and-under. + +(defun rst-Hdr--validate-ado (ado) + ;; testcover: ok. + "Validate ADO to be a valid adornment. +Return ADO if so or signal an error otherwise." + (cond + ((not (rst-Ado-p ado)) + (signal 'wrong-type-argument + (list 'rst-Ado-p ado))) + ((rst-Ado-is-transition ado) + (signal 'args-out-of-range + '("Adornment for header must not be transition."))) + (t + ado))) + +;; Public class methods + +(defun rst-Hdr-preferred-adornments () + ;; testcover: ok. + "Return preferred adornments as list of `rst-Hdr'." + (mapcar (lambda (el) + (rst-Hdr-new-lax + (if (eq (cadr el) 'over-and-under) + (rst-Ado-new-over-and-under (car el)) + (rst-Ado-new-simple (car el))) + (caddr el))) + rst-preferred-adornments)) + +;; Public methods + +(defun rst-Hdr-member-ado (self hdrs) + ;; testcover: ok. + "Return sublist of HDRS whose car's adornment equals that of SELF or nil." + (unless (rst-Hdr-p self) + (signal 'wrong-type-argument + (list 'rst-Hdr-p self))) + (let ((pos (rst-Ado-position (rst-Hdr-ado self) (rst-Hdr-ado-map hdrs)))) + (and pos (nthcdr pos hdrs)))) + +(defun rst-Hdr-ado-map (selfs) + ;; testcover: ok. + "Return `rst-Ado' list extracted from elements of SELFS." + (mapcar 'rst-Hdr-ado selfs)) + +(defun rst-Hdr-get-char (self) + ;; testcover: ok. + "Return character of the adornment of SELF." + (unless (rst-Hdr-p self) + (signal 'wrong-type-argument + (list 'rst-Hdr-p self))) + (rst-Ado-char (rst-Hdr-ado self))) + +(defun rst-Hdr-is-over-and-under (self) + ;; testcover: ok. + "Return non-nil if SELF is a over-and-under section header." + (unless (rst-Hdr-p self) + (signal 'wrong-type-argument + (list 'rst-Hdr-p self))) + (rst-Ado-is-over-and-under (rst-Hdr-ado self))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Ttl + +(defstruct + (rst-Ttl + (:constructor nil) ;; Prevent creating unchecked values. + ;; Construct with valid parameters for all attributes. + (:constructor + rst-Ttl-new + (ado-arg + match-arg + indent-arg + text-arg + &optional + hdr-arg + level-arg + &aux + (ado (rst-Ttl--validate-ado ado-arg)) + (match (rst-Ttl--validate-match match-arg ado)) + (indent (rst-Ttl--validate-indent indent-arg ado)) + (text (rst-Ttl--validate-text text-arg ado)) + (hdr (and hdr-arg (rst-Ttl--validate-hdr hdr-arg ado indent))) + (level (and level-arg (rst-Ttl--validate-level level-arg))))) + (:copier rst-Ttl-copy)) + "Representation of a reStructuredText section header as found in the buffer. +This type gathers information about an adorned part in the +buffer. Thus only the basic attributes are immutable. Although +the remaining attributes are `setf'-able the respective setters +should be used." + ;; The adornment characteristics or nil for a title candidate. + (ado nil :read-only t) + ;; The match-data for `ado' as returned by `match-data'. Match group 0 + ;; matches the whole construct. Match group 1 matches the overline adornment + ;; if present. Match group 2 matches the section title text or the + ;; transition. Match group 3 matches the underline adornment. + (match nil :read-only t) + ;; An indentation found for the title line or nil for a transition. + (indent nil :read-only t) + ;; The text of the title or nil for a transition. + (text nil :read-only t) + ;; The header characteristics if it is a valid section header. + (hdr nil) + ;; The hierarchical level of the section header starting with 0. + (level nil)) + +;; Private class methods + +(defun rst-Ttl--validate-ado (ado) + ;; testcover: ok. + "Return valid ADO or signal error." + (unless (or (null ado) (rst-Ado-p ado)) + (signal 'wrong-type-argument + (list 'null 'rst-Ado-p ado))) + ado) + +(defun rst-Ttl--validate-match (match ado) + ;; testcover: ok. + "Return valid MATCH matching ADO or signal error." + (unless (listp match) + (signal 'wrong-type-argument + (list 'listp match))) + (unless (equal (length match) 8) + (signal 'args-out-of-range + '("Match data must consist of exactly 8 buffer positions."))) + (mapcar (lambda (pos) + (unless (or (null pos) (integer-or-marker-p pos)) + (signal 'wrong-type-argument + (list 'integer-or-marker-p 'null pos)))) + match) + (unless (and (integer-or-marker-p (nth 0 match)) + (integer-or-marker-p (nth 1 match))) + (signal 'args-out-of-range + '("First two elements of match data must be buffer positions."))) + (cond + ((null ado) + (unless (and (null (nth 2 match)) + (null (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (null (nth 6 match)) + (null (nth 7 match))) + (signal 'args-out-of-range + '("For a title candidate exactly the third match pair must be set.")))) + ((rst-Ado-is-transition ado) + (unless (and (null (nth 2 match)) + (null (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (null (nth 6 match)) + (null (nth 7 match))) + (signal 'args-out-of-range + '("For a transition exactly the third match pair must be set.")))) + ((rst-Ado-is-simple ado) + (unless (and (null (nth 2 match)) + (null (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (integer-or-marker-p (nth 6 match)) + (integer-or-marker-p (nth 7 match))) + (signal 'args-out-of-range + '("For a simple section adornment exactly the third and fourth match pair must be set.")))) + (t ;; over-and-under + (unless (and (integer-or-marker-p (nth 2 match)) + (integer-or-marker-p (nth 3 match)) + (integer-or-marker-p (nth 4 match)) + (integer-or-marker-p (nth 5 match)) + (or (null (nth 6 match)) (integer-or-marker-p (nth 6 match))) + (or (null (nth 7 match)) (integer-or-marker-p (nth 7 match)))) + (signal 'args-out-of-range + '("For a over-and-under section adornment all match pairs must be set."))))) + match) + +(defun rst-Ttl--validate-indent (indent ado) + ;; testcover: ok. + "Return valid INDENT for ADO or signal error." + (if (and ado (rst-Ado-is-transition ado)) + (unless (null indent) + (signal 'args-out-of-range + '("Indent for a transition must be nil."))) + (unless (integerp indent) + (signal 'wrong-type-argument + (list 'integerp indent))) + (unless (>= indent 0) + (signal 'args-out-of-range + '("Indent for a section header must be non-negative.")))) + indent) + +(defun rst-Ttl--validate-hdr (hdr ado indent) + ;; testcover: ok. + "Return valid HDR in relation to ADO and INDENT or signal error." + (unless (rst-Hdr-p hdr) + (signal 'wrong-type-argument + (list 'rst-Hdr-p hdr))) + (unless (rst-Ado-equal (rst-Hdr-ado hdr) ado) + (signal 'args-out-of-range + '("Basic adornment and adornment in header must match."))) + (unless (equal (rst-Hdr-indent hdr) indent) + (signal 'args-out-of-range + '("Basic indent and indent in header must match."))) + hdr) + +(defun rst-Ttl--validate-text (text ado) + ;; testcover: ok. + "Return valid TEXT for ADO or signal error." + (if (and ado (rst-Ado-is-transition ado)) + (unless (null text) + (signal 'args-out-of-range + '("Transitions may not have title text."))) + (unless (stringp text) + (signal 'wrong-type-argument + (list 'stringp text)))) + text) + +(defun rst-Ttl--validate-level (level) + ;; testcover: ok. + "Return valid LEVEL or signal error." + (unless (integerp level) + (signal 'wrong-type-argument + (list 'integerp level))) + (unless (>= level 0) + (signal 'args-out-of-range + '("Level must be non-negative."))) + level) + +;; Public methods + +(defun rst-Ttl-evaluate-hdr (self) + ;; testcover: ok. + "Check for `ado' and `indent' in SELF forming a valid `rst-Hdr'. +Set and return it or nil if no valid `rst-Hdr' can be formed." + (setf (rst-Ttl-hdr self) + (condition-case nil + (rst-Hdr-new (rst-Ttl-ado self) (rst-Ttl-indent self)) + (error nil)))) + +(defun rst-Ttl-set-level (self level) + ;; testcover: ok. + "In SELF set and return LEVEL or nil if invalid." + (setf (rst-Ttl-level self) + (rst-Ttl--validate-level level))) + +(defun rst-Ttl-get-title-beginning (self) + ;; testcover: ok. + "Return position of beginning of title text of SELF. +This position should always be at the start of a line." + (nth 4 (rst-Ttl-match self))) + +(defun rst-Ttl-get-beginning (self) + ;; testcover: ok. + "Return position of beginning of whole SELF." + (nth 0 (rst-Ttl-match self))) + +(defun rst-Ttl-get-end (self) + ;; testcover: ok. + "Return position of end of whole SELF." + (nth 1 (rst-Ttl-match self))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Stn + +(defstruct + (rst-Stn + (:constructor nil) ;; Prevent creating unchecked values. + ;; Construct while all parameters must be valid. + (:constructor + rst-Stn-new + (ttl-arg + level-arg + children-arg + &aux + (ttl (rst-Stn--validate-ttl ttl-arg)) + (level (rst-Stn--validate-level level-arg ttl)) + (children (rst-Stn--validate-children children-arg ttl))))) + "Representation of a section tree node. + +This type is immutable." + ;; The title of the node or nil for a missing node. + (ttl nil :read-only t) + ;; The level of the node in the tree. Negative for the (virtual) top level + ;; node. + (level nil :read-only t) + ;; The list of children of the node. + (children nil :read-only t)) + +;; Private class methods + +(defun rst-Stn--validate-ttl (ttl) + ;; testcover: ok. + "Return valid TTL or signal error." + (unless (or (null ttl) (rst-Ttl-p ttl)) + (signal 'wrong-type-argument + (list 'null 'rst-Ttl-p ttl))) + ttl) + +(defun rst-Stn--validate-level (level ttl) + ;; testcover: ok. + "Return valid LEVEL for TTL or signal error." + (unless (integerp level) + (signal 'wrong-type-argument + (list 'integerp level))) + (when ttl + (unless (or (not (rst-Ttl-level ttl)) + (equal (rst-Ttl-level ttl) level)) + (signal 'args-out-of-range + '("A title must have correct level or none at all."))) + (when (< level 0) + ;; testcover: Never reached because a title may not have a negative level + (signal 'args-out-of-range + '("Top level node must not have a title.")))) + level) + +(defun rst-Stn--validate-children (children ttl) + ;; testcover: ok. + "Return valid CHILDREN for TTL or signal error." + (unless (listp children) + (signal 'wrong-type-argument + (list 'listp children))) + (mapcar (lambda (child) + (unless (rst-Stn-p child) + (signal 'wrong-type-argument + (list 'rst-Stn-p child)))) + children) + (unless (or ttl children) + (signal 'args-out-of-range + '("A missing node must have children."))) + children) + +;; Public methods + +(defun rst-Stn-get-title-beginning (self) + ;; testcover: ok. + "Return the beginning of the title of SELF. +Handles missing node properly." + (unless (rst-Stn-p self) + (signal 'wrong-type-argument + (list 'rst-Stn-p self))) + (let ((ttl (rst-Stn-ttl self))) + (if ttl + (rst-Ttl-get-title-beginning ttl) + (rst-Stn-get-title-beginning (car (rst-Stn-children self)))))) + +(defun rst-Stn-get-text (self &optional default) + ;; testcover: ok. + "Return title text of SELF or DEFAULT if SELF is a missing node. +For a missing node and no DEFAULT given return a standard title text." + (unless (rst-Stn-p self) + (signal 'wrong-type-argument + (list 'rst-Stn-p self))) + (let ((ttl (rst-Stn-ttl self))) + (cond + (ttl + (rst-Ttl-text ttl)) + (default) + ("[missing node]")))) + +(defun rst-Stn-is-top (self) + ;; testcover: ok. + "Return non-nil if SELF is a top level node." + (unless (rst-Stn-p self) + (signal 'wrong-type-argument + (list 'rst-Stn-p self))) + (< (rst-Stn-level self) 0)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mode definition -;; testcover: ok. (defun rst-define-key (keymap key def &rest deprecated) + ;; testcover: ok. "Bind like `define-key' but add deprecated key definitions. KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key definitions should be in vector notation. These are defined @@ -619,7 +1199,7 @@ (if (string-match "^rst-\\(.*\\)$" command-name) (concat "rst-deprecated-" (match-string 1 command-name)) - (error "not an RST command: %s" command-name))) + (error "Not an RST command: %s" command-name))) (forwarder-function (intern forwarder-function-name))) (unless (fboundp forwarder-function) (defalias forwarder-function @@ -634,6 +1214,7 @@ def def))) (dolist (dep-key deprecated) (define-key keymap dep-key forwarder-function))))) + ;; Key bindings. (defvar rst-mode-map (let ((map (make-sparse-keymap))) @@ -655,9 +1236,9 @@ (rst-define-key map [?\C-c ?\C-a ?\C-a] 'rst-adjust) ;; Display the hierarchy of adornments implied by the current document ;; contents. - (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-adornments-hierarchy) + (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-hdr-hierarchy) ;; Homogenize the adornments in the document. - (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-adornments + (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-sections [?\C-c ?\C-s]) ;; @@ -819,71 +1400,62 @@ :group 'rst ;; Paragraph recognition. - (set (make-local-variable 'paragraph-separate) - (rst-re '(:alt - "\f" - lin-end))) - (set (make-local-variable 'paragraph-start) - (rst-re '(:alt - "\f" - lin-end - (:seq hws-tag par-tag- bli-sfx)))) + (setq-local paragraph-separate + (rst-re '(:alt + "\f" + lin-end))) + (setq-local paragraph-start + (rst-re '(:alt + "\f" + lin-end + (:seq hws-tag par-tag- bli-sfx)))) ;; Indenting and filling. - (set (make-local-variable 'indent-line-function) 'rst-indent-line) - (set (make-local-variable 'adaptive-fill-mode) t) - (set (make-local-variable 'adaptive-fill-regexp) - (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) - (set (make-local-variable 'adaptive-fill-function) 'rst-adaptive-fill) - (set (make-local-variable 'fill-paragraph-handle-comment) nil) + (setq-local indent-line-function 'rst-indent-line) + (setq-local adaptive-fill-mode t) + (setq-local adaptive-fill-regexp (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) + (setq-local adaptive-fill-function 'rst-adaptive-fill) + (setq-local fill-paragraph-handle-comment nil) ;; Comments. - (set (make-local-variable 'comment-start) ".. ") - (set (make-local-variable 'comment-start-skip) - (rst-re 'lin-beg 'exm-tag 'bli-sfx)) - (set (make-local-variable 'comment-continue) " ") - (set (make-local-variable 'comment-multi-line) t) - (set (make-local-variable 'comment-use-syntax) nil) + (setq-local comment-start ".. ") + (setq-local comment-start-skip (rst-re 'lin-beg 'exm-tag 'bli-sfx)) + (setq-local comment-continue " ") + (setq-local comment-multi-line t) + (setq-local comment-use-syntax nil) ;; reStructuredText has not really a comment ender but nil is not really a ;; permissible value. - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-end-skip) nil) + (setq-local comment-end "") + (setq-local comment-end-skip nil) ;; Commenting in reStructuredText is very special so use our own set of ;; functions. - (set (make-local-variable 'comment-line-break-function) - 'rst-comment-line-break) - (set (make-local-variable 'comment-indent-function) - 'rst-comment-indent) - (set (make-local-variable 'comment-insert-comment-function) - 'rst-comment-insert-comment) - (set (make-local-variable 'comment-region-function) - 'rst-comment-region) - (set (make-local-variable 'uncomment-region-function) - 'rst-uncomment-region) + (setq-local comment-line-break-function 'rst-comment-line-break) + (setq-local comment-indent-function 'rst-comment-indent) + (setq-local comment-insert-comment-function 'rst-comment-insert-comment) + (setq-local comment-region-function 'rst-comment-region) + (setq-local uncomment-region-function 'rst-uncomment-region) - (set (make-local-variable 'electric-pair-pairs) - '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) + (setq-local 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) + (setq-local imenu-create-index-function 'rst-imenu-create-index) ;; Font lock. - (set (make-local-variable 'font-lock-defaults) - '(rst-font-lock-keywords - t nil nil nil - (font-lock-multiline . t) - (font-lock-mark-block-function . mark-paragraph))) + (setq-local font-lock-defaults + '(rst-font-lock-keywords + t nil nil nil + (font-lock-multiline . t) + (font-lock-mark-block-function . mark-paragraph))) (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) + (setq-local jit-lock-contextually t) ;; Indentation is not deterministic. - (setq electric-indent-inhibit t)) + (setq-local electric-indent-inhibit t)) ;;;###autoload (define-minor-mode rst-minor-mode @@ -909,38 +1481,14 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Section Adornment Adjustment -;; ============================ -;; +;; Section adornment adjustment + ;; The following functions implement a smart automatic title sectioning feature. ;; The idea is that with the cursor sitting on a section title, we try to get as ;; much information from context and try to do the best thing automatically. ;; This function can be invoked many times and/or with prefix argument to rotate ;; between the various sectioning adornments. ;; -;; Definitions: the two forms of sectioning define semantically separate section -;; levels. A sectioning ADORNMENT consists in: -;; -;; - a CHARACTER -;; -;; - a STYLE which can be either of 'simple' or 'over-and-under'. -;; -;; - an INDENT (meaningful for the over-and-under style only) which determines -;; how many characters and over-and-under style is hanging outside of the -;; title at the beginning and ending. -;; -;; Here are two examples of adornments (| represents the window border, column -;; 0): -;; -;; | -;; 1. char: '-' e |Some Title -;; style: simple |---------- -;; | -;; 2. char: '=' |============== -;; style: over-and-under | Some Title -;; indent: 2 |============== -;; | -;; ;; Some notes: ;; ;; - The underlining character that is used depends on context. The file is @@ -949,7 +1497,7 @@ ;; rotated among the existing section adornments. ;; ;; Note that when rotating the characters, if we come to the end of the -;; hierarchy of adornments, the variable rst-preferred-adornments is +;; hierarchy of adornments, the variable `rst-preferred-adornments' is ;; consulted to propose a new underline adornment, and if continued, we cycle ;; the adornments all over again. Set this variable to nil if you want to ;; limit the underlining character propositions to the existing adornments in @@ -987,6 +1535,8 @@ (define-obsolete-variable-alias 'rst-preferred-decorations 'rst-preferred-adornments "rst 1.0.0") +;; FIXME: Default must match suggestion in +;; http://sphinx-doc.org/rest.html#sections for Python documentation. (defcustom rst-preferred-adornments '((?= over-and-under 1) (?= simple 0) (?- simple 0) @@ -996,13 +1546,10 @@ (?# simple 0) (?@ simple 0)) "Preferred hierarchy of section title adornments. - 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. +wanted indentation for STYLE `over-and-under'. This sequence is consulted to offer a new adornment suggestion when we rotate the underlines at the end of the existing @@ -1026,156 +1573,111 @@ :value 0)))) (rst-testcover-defcustom) +;; FIXME: Rename this to `rst-over-and-under-default-indent' and set default to +;; 0 because the effect of 1 is probably surprising in the few cases +;; where this is used. +;; FIXME: A matching adornment style can be looked for in +;; `rst-preferred-adornments' and its indentation used before using this +;; variable. (defcustom rst-default-indent 1 "Number of characters to indent the section title. - -This is used for when toggling adornment styles, when switching +This is only used while toggling adornment styles when switching from a simple adornment style to a over-and-under adornment -style." +style. In addition this is used in cases where the adornments +found in the buffer are to be used but the indentation for +over-and-under adornments is inconsistent across the buffer." :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)." - (and (eq (car ado1) (car ado2)) - (eq (cadr ado1) (cadr ado2)))) +(defun rst-new-preferred-hdr (seen prev) + ;; testcover: ok. + "Return a new, preferred `rst-Hdr' different from all in SEEN. +PREV is the previous `rst-Hdr' in the buffer. If given the +search starts after this entry. Return nil if no new preferred +`rst-Hdr' can be found." + ;; All preferred adornments are candidates. + (let ((candidates + (append + (if prev + ;; Start searching after the level of the previous adornment. + (cdr (rst-Hdr-member-ado prev (rst-Hdr-preferred-adornments)))) + (rst-Hdr-preferred-adornments)))) + (car + (rst-member-if (lambda (cand) + (not (rst-Hdr-member-ado cand seen))) + candidates)))) - -(defun rst-get-adornment-match (hier ado) - "Return the index (level) in hierarchy HIER of adornment ADO. -This basically just searches for the item using the appropriate -comparison and returns the index. Return nil if the item is -not found." - (let ((cur hier)) - (while (and cur (not (rst-compare-adornments (car cur) ado))) - (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. - -ALLADOS is the set of all adornments, including the line numbers. -PREV is the optional previous adornment, in order to suggest a -better match." - - ;; For all the preferred adornments... - (let* ( - ;; If 'prev' is given, reorder the list to start searching after the - ;; match. - (fplist - (cdr (rst-get-adornment-match rst-preferred-adornments prev))) - - ;; List of candidates to search. - (curpotential (append fplist rst-preferred-adornments))) - (while - ;; For all the adornments... - (let ((cur allados) - found) - (while (and cur (not found)) - (if (rst-compare-adornments (car cur) (car curpotential)) - ;; Found it! - (setq found (car curpotential)) - (setq cur (cdr cur)))) - found) - - (setq curpotential (cdr curpotential))) - - (copy-sequence (car curpotential)))) - (defun rst-delete-entire-line () "Delete the entire current line without using the `kill-ring'." (delete-region (line-beginning-position) (line-beginning-position 2))) -(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 -is always assumed to be 0). - +(defun rst-update-section (hdr) + "Unconditionally update the style of the section header at point to HDR. If there are existing overline and/or underline from the existing adornment, they are removed before adding the requested adornment." (end-of-line) - (let ((marker (point-marker)) - len) + (let ((indent (or (rst-Hdr-indent hdr) 0)) + (marker (point-marker)) + len) - ;; Fixup whitespace at the beginning and end of the line. - (if (or (null indent) (eq style 'simple)) ;; testcover: ok. - (setq indent 0)) - (beginning-of-line) - (delete-horizontal-space) - (insert (make-string indent ? )) + ;; Fixup whitespace at the beginning and end of the line. + (beginning-of-line) + (delete-horizontal-space) + (insert (make-string indent ? )) - (end-of-line) - (delete-horizontal-space) + (end-of-line) + (delete-horizontal-space) - ;; Set the current column, we're at the end of the title line. - (setq len (+ (current-column) indent)) + ;; Set the current column, we're at the end of the title line. + (setq len (+ (current-column) indent)) - ;; Remove previous line if it is an adornment. - (save-excursion - (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) - (not (looking-at (rst-re 'ttl-beg))))) - (rst-delete-entire-line))) + ;; Remove previous line if it is an adornment. + (save-excursion + (forward-line -1) ;; FIXME testcover: 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) + (not (looking-at (rst-re 'ttl-beg-1))))) + (rst-delete-entire-line))) - ;; Remove following line if it is an adornment. + ;; Remove following line if it is an adornment. + (save-excursion + (forward-line +1) ;; FIXME testcover: 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 unless it is the final + ;; empty line, for the subsequent inserting of the underline. + (if (and (= (point) (buffer-end 1)) (not (bolp))) + (newline 1))) + + ;; Insert overline. + (when (rst-Hdr-is-over-and-under hdr) (save-excursion - (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 - ;; inserting of the underline. - (if (= (point) (buffer-end 1)) - (newline 1))) + (beginning-of-line) + (open-line 1) + (insert (make-string len (rst-Hdr-get-char hdr))))) - ;; Insert overline. - (if (eq style 'over-and-under) - (save-excursion - (beginning-of-line) - (open-line 1) - (insert (make-string len char)))) + ;; Insert underline. + (1value ;; Line has been inserted above. + (forward-line +1)) + (open-line 1) + (insert (make-string len (rst-Hdr-get-char hdr))) - ;; Insert underline. - (1value ;; Line has been inserted above. - (forward-line +1)) - (open-line 1) - (insert (make-string len char)) + (1value ;; Line has been inserted above. + (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. + "Classify adornment string for section titles and transitions. ADORNMENT is the complete adornment string as found in the buffer with optional trailing whitespace. END is the point after the -last character of ADORNMENT. - -Return a list. The first entry is t for a transition or a -cons (CHARACTER . STYLE). Check `rst-preferred-adornments' for -the meaning of CHARACTER and STYLE. - -The remaining list forms four match groups as returned by -`match-data'. Match group 0 matches the whole construct. Match -group 1 matches the overline adornment if present. Match group 2 -matches the section title text or the transition. Match group 3 -matches the underline adornment. - -Return nil if no syntactically valid adornment is found." +last character of ADORNMENT. Return a `rst-Ttl' or nil if no +syntactically valid adornment is found." (save-excursion (save-match-data (when (string-match (rst-re 'ado-beg-2-1) adornment) @@ -1190,31 +1692,35 @@ (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. + ;; FIXME testcover: Add test classifying at the end of + ;; buffer. (looking-at (rst-re 'lin-end))))) (prv-emp ; Previous line nonexistent or empty (save-excursion (or (not (zerop (forward-line -1))) (looking-at (rst-re 'lin-end))))) + txt-blw (ttl-blw ; Title found below starting here. (save-excursion (and - (zerop (forward-line 1)) ;; testcover: FIXME: Add test + (zerop (forward-line 1)) ;; FIXME testcover: Add test ;; classifying at the end of ;; buffer. - (looking-at (rst-re 'ttl-beg)) + (looking-at (rst-re 'ttl-beg-1)) + (setq txt-blw (match-string-no-properties 1)) (point)))) + txt-abv (ttl-abv ; Title found above starting here. (save-excursion (and (zerop (forward-line -1)) - (looking-at (rst-re 'ttl-beg)) + (looking-at (rst-re 'ttl-beg-1)) + (setq txt-abv (match-string-no-properties 1)) (point)))) (und-fnd ; Matching underline found starting here. (save-excursion (and ttl-blw - (zerop (forward-line 2)) ;; testcover: FIXME: Add test + (zerop (forward-line 2)) ;; FIXME testcover: Add test ;; classifying at the end of ;; buffer. (looking-at (rst-re ado-re 'lin-end)) @@ -1225,16 +1731,16 @@ (zerop (forward-line -2)) (looking-at (rst-re ado-re 'lin-end)) (point)))) - key beg-ovr end-ovr beg-txt end-txt beg-und end-und) + ado ind txt beg-ovr end-ovr beg-txt end-txt beg-und end-und) (cond ((and nxt-emp prv-emp) ;; A transition. - (setq key t + (setq ado (rst-Ado-new-transition) beg-txt beg-pnt end-txt end-pnt)) ((or und-fnd ovr-fnd) ;; An overline with an underline. - (setq key (cons ado-ch 'over-and-under)) + (setq ado (rst-Ado-new-over-and-under ado-ch)) (let (;; Prefer overline match over underline match. (und-pnt (if ovr-fnd beg-pnt und-fnd)) (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt)) @@ -1244,41 +1750,40 @@ end-ovr (line-end-position)) (goto-char txt-pnt) (setq beg-txt (point) - end-txt (line-end-position)) + end-txt (line-end-position) + ind (current-indentation) + txt (if ovr-fnd txt-abv txt-blw)) (goto-char und-pnt) (setq beg-und (point) end-und (line-end-position)))) (ttl-abv ;; An underline. - (setq key (cons ado-ch 'simple) + (setq ado (rst-Ado-new-simple ado-ch) beg-und beg-pnt end-und end-pnt) (goto-char ttl-abv) (setq beg-txt (point) - end-txt (line-end-position))) + end-txt (line-end-position) + ind (current-indentation) + txt txt-abv)) (t ;; Invalid adornment. - (setq key nil))) - (if key - (list key - (or beg-ovr beg-txt) - (or end-und end-txt) - beg-ovr end-ovr beg-txt end-txt beg-und end-und))))))) + (setq ado nil))) + (if ado + (rst-Ttl-new ado + (list + (or beg-ovr beg-txt) + (or end-und end-txt) + beg-ovr end-ovr beg-txt end-txt beg-und end-und) + ind txt))))))) -(defun rst-find-title-line () +(defun rst-ttl-at-point () "Find a section title line around point and return its characteristics. If the point is on an adornment line find the respective title line. If the point is on an empty line check previous or next line whether it is a suitable title line and use it if so. If -point is on a suitable title line use it. - -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, -CHARACTER is also nil and match groups for overline and underline -are nil." +point is on a suitable title line use it. Return a `rst-Ttl' for +a section header or nil if no title line is found." (save-excursion (1value ;; No lines may be left to move. (forward-line 0)) @@ -1286,225 +1791,258 @@ (orig-end (line-end-position))) (cond ((looking-at (rst-re 'ado-beg-2-1)) + ;; Adornment found - consider it. (let ((char (string-to-char (match-string-no-properties 2))) (r (rst-classify-adornment (match-string-no-properties 0) (match-end 0)))) (cond ((not r) - ;; Invalid adornment - check whether this is an incomplete overline. + ;; Invalid adornment - check whether this is an overline with + ;; missing underline. (if (and (zerop (forward-line 1)) - (looking-at (rst-re 'ttl-beg))) - (list (cons char nil) orig-pnt (line-end-position) - orig-pnt orig-end (point) (line-end-position) nil nil))) - ((consp (car r)) - ;; A section title - not a transition. - r)))) + (looking-at (rst-re 'ttl-beg-1))) + (rst-Ttl-new (rst-Ado-new-over-and-under char) + (list orig-pnt (line-end-position) + orig-pnt orig-end + (point) (line-end-position) + nil nil) + (current-indentation) + (match-string-no-properties 1)))) + ((rst-Ado-is-transition (rst-Ttl-ado r)) + nil) + ;; Return any other classification as is. + (r)))) ((looking-at (rst-re 'lin-end)) + ;; Empty line found - check surrounding lines for a title. (or (save-excursion (if (and (zerop (forward-line -1)) - (looking-at (rst-re 'ttl-beg))) - (list (cons nil nil) (point) (line-end-position) - nil nil (point) (line-end-position) nil nil))) + (looking-at (rst-re 'ttl-beg-1))) + (rst-Ttl-new nil + (list (point) (line-end-position) + nil nil + (point) (line-end-position) + nil nil) + (current-indentation) + (match-string-no-properties 1)))) (save-excursion (if (and (zerop (forward-line 1)) - (looking-at (rst-re 'ttl-beg))) - (list (cons nil nil) (point) (line-end-position) - nil nil (point) (line-end-position) nil nil))))) - ((looking-at (rst-re 'ttl-beg)) - ;; Try to use the underline. - (let ((r (rst-classify-adornment - (buffer-substring-no-properties - (line-beginning-position 2) (line-end-position 2)) - (line-end-position 2)))) - (if r - r - ;; No valid adornment found. - (list (cons nil nil) (point) (line-end-position) - nil nil (point) (line-end-position) nil nil)))))))) + (looking-at (rst-re 'ttl-beg-1))) + (rst-Ttl-new nil + (list (point) (line-end-position) + nil nil + (point) (line-end-position) + nil nil) + (current-indentation) + (match-string-no-properties 1)))))) + ((looking-at (rst-re 'ttl-beg-1)) + ;; Title line found - check for a following underline. + (let ((txt (match-string-no-properties 1))) + (or (rst-classify-adornment + (buffer-substring-no-properties + (line-beginning-position 2) (line-end-position 2)) + (line-end-position 2)) + ;; No valid adornment found. + (rst-Ttl-new nil + (list (point) (line-end-position) + nil nil + (point) (line-end-position) + nil nil) + (current-indentation) + txt)))))))) ;; The following function and variables are used to maintain information about ;; current section adornment in a buffer local cache. Thus they can be used for ;; font-locking and manipulation commands. -(defvar rst-all-sections nil - "All section adornments in the buffer as found by `rst-find-all-adornments'. +(defvar rst-all-ttls-cache nil + "All section adornments in the buffer as found by `rst-all-ttls'. Set to t when no section adornments were found.") -(make-variable-buffer-local 'rst-all-sections) +(make-variable-buffer-local 'rst-all-ttls-cache) ;; 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'. +(defvar rst-hdr-hierarchy-cache nil + "Section hierarchy in the buffer as determined by `rst-hdr-hierarchy'. Set to t when no section adornments were found. -Value depends on `rst-all-sections'.") -(make-variable-buffer-local 'rst-section-hierarchy) +Value depends on `rst-all-ttls-cache'.") +(make-variable-buffer-local 'rst-hdr-hierarchy-cache) (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." - (setq rst-all-sections nil - rst-section-hierarchy nil)) + (setq rst-all-ttls-cache nil + rst-hdr-hierarchy-cache nil)) -(defun rst-find-all-adornments () +(defun rst-all-ttls () "Return all the section adornments in the current buffer. -Return a list of (LINE . ADORNMENT) with ascending LINE where -LINE is the line containing the section title. ADORNMENT consists -of a (CHARACTER STYLE INDENT) triple as described for -`rst-preferred-adornments'. +Return a list of `rst-Ttl' with ascending line number. -Uses and sets `rst-all-sections'." - (unless rst-all-sections +Uses and sets `rst-all-ttls-cache'." + (unless rst-all-ttls-cache (let (positions) ;; Iterate over all the section titles/adornments in the file. (save-excursion - (goto-char (point-min)) - (while (re-search-forward (rst-re 'ado-beg-2-1) nil t) - (let ((ado-data (rst-classify-adornment - (match-string-no-properties 0) (point)))) - (when (and ado-data - (consp (car ado-data))) ; Ignore transitions. - (set-match-data (cdr ado-data)) - (goto-char (match-beginning 2)) ; Goto the title start. - (push (cons (1+ (count-... [truncated message content] |
From: <sm...@us...> - 2017-01-03 21:56:21
|
Revision: 8011 http://sourceforge.net/p/docutils/code/8011 Author: smerten Date: 2017-01-03 21:56:17 +0000 (Tue, 03 Jan 2017) Log Message: ----------- Lots of refactorings and a few minor improvements. User visible improvements and changes: * Improve and debug `rst-forward-section` and `rst-backward-section`. * Auto-enumeration may be used with all styles for list insertion. * Improve and debug `rst-toc-insert`. * Adapt change in Emacs to use customization group `text` instead of `wp`. * Bind `n` and `p` in `rst-toc-mode`. * `z` in `toc-mode` returns to the previous window configuration. * Require Emacs version >= 24.1. Lots of refactorings including: * Silence byte compiler. * Use lexical binding. * Use `cl-lib`. * Add tests and raise test coverage. Modified Paths: -------------- trunk/docutils/tools/editors/emacs/IDEAS.rst trunk/docutils/tools/editors/emacs/rst.el trunk/docutils/tools/editors/emacs/tests/Ado.el trunk/docutils/tools/editors/emacs/tests/Hdr.el trunk/docutils/tools/editors/emacs/tests/Stn.el trunk/docutils/tools/editors/emacs/tests/Ttl.el trunk/docutils/tools/editors/emacs/tests/adjust-section.el trunk/docutils/tools/editors/emacs/tests/adjust-uc.el trunk/docutils/tools/editors/emacs/tests/adornment.el trunk/docutils/tools/editors/emacs/tests/apply-block.el trunk/docutils/tools/editors/emacs/tests/buffer.el trunk/docutils/tools/editors/emacs/tests/comment.el trunk/docutils/tools/editors/emacs/tests/ert-buffer.el trunk/docutils/tools/editors/emacs/tests/fill.el trunk/docutils/tools/editors/emacs/tests/font-lock.el trunk/docutils/tools/editors/emacs/tests/imenu.el trunk/docutils/tools/editors/emacs/tests/indent.el trunk/docutils/tools/editors/emacs/tests/init.el trunk/docutils/tools/editors/emacs/tests/items.el trunk/docutils/tools/editors/emacs/tests/movement.el trunk/docutils/tools/editors/emacs/tests/re.el trunk/docutils/tools/editors/emacs/tests/shift.el trunk/docutils/tools/editors/emacs/tests/toc.el trunk/docutils/tools/editors/emacs/tests/tree.el Added Paths: ----------- trunk/docutils/tools/editors/emacs/tests/helpers.el Removed Paths: ------------- trunk/docutils/tools/editors/emacs/tests/cl.el Modified: trunk/docutils/tools/editors/emacs/IDEAS.rst =================================================================== --- trunk/docutils/tools/editors/emacs/IDEAS.rst 2017-01-03 16:14:00 UTC (rev 8010) +++ trunk/docutils/tools/editors/emacs/IDEAS.rst 2017-01-03 21:56:17 UTC (rev 8011) @@ -668,3 +668,63 @@ blank by a soft newline * May be `longlines-*search-*` needs to be adapted as well? + +Indent correctly +================ + +* `rst-shift-region` should have a mode to indent correctly + + * I.e.: Indent the region according to the tab given by the line + above + +* But see also `Copying literal blocks`_ + +Jumps leaving mark +================== + +* All jumps across a wider distance should push the mark on the local + mark ring + + * See C-u C-SPC documentation + + * Jumps to section titles + + * That would result in jumping back to TOC which is especially + useful for an internal TOC + + * But not jumps to paragraphs + + * Jumps with C-M-a / C-M-e? + +TOC controlling sliding window +============================== + +* `toc-mode` must have a mode where cursor entering a new line moves + to the respective section in another window + + * So one can browse through a buffer by using the TOC + +Jump to list entry on same level +================================ + +* If on a list entry of some sort there should be a way to navigate to + a sibling + + * Forward and backward + +* May be also up and down + +`rst-shift-region` shifts as needed +=================================== + +* `rst-shift-region` should have an option to "do the right thing" + +* In particular it should shift as needed by the text above + + * This makes indentation of an inserted block easier because you + don't need to know the correct number of tabs + + * There should be an option to "align under", "align same" and + "align less" + + * May be this could be commanded by one or more C-u's Modified: trunk/docutils/tools/editors/emacs/rst.el =================================================================== --- trunk/docutils/tools/editors/emacs/rst.el 2017-01-03 16:14:00 UTC (rev 8010) +++ trunk/docutils/tools/editors/emacs/rst.el 2017-01-03 21:56:17 UTC (rev 8011) @@ -1,6 +1,6 @@ -;;; rst.el --- Mode for viewing and editing reStructuredText-documents. +;;; rst.el --- Mode for viewing and editing reStructuredText-documents -*- lexical-binding: t -*- -;; Copyright (C) 2003-2016 Free Software Foundation, Inc. +;; Copyright (C) 2003-2017 Free Software Foundation, Inc. ;; Maintainer: Stefan Merten <stefan at merten-home dot de> ;; Author: Stefan Merten <stefan at merten-home dot de>, @@ -100,16 +100,31 @@ ;; FIXME: Check through major mode conventions again. -;; FIXME: Add proper ";;;###autoload" comments. +;; FIXME: Embed complicated `defconst's in `eval-when-compile'. -;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*- -;; lexical-binding: t -*-" in the first line. +;; Common Lisp stuff +(require 'cl-lib) -;; FIXME: Embed complicated `defconst's in `eval-when-compile'. +;; Correct wrong declaration. +(def-edebug-spec push + (&or [form symbolp] [form gv-place])) -;; FIXME: Use `testcover'. Mark up a function with sufficient test coverage by -;; a comment tagged with `testcover' after the `defun'. +;; Correct wrong declaration. This still doesn't support dotted desctructuring +;; though. +(def-edebug-spec cl-lambda-list + (([&rest cl-macro-arg] + [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] + [&optional ["&rest" arg]] + [&optional ["&key" [cl-&key-arg &rest cl-&key-arg] + &optional "&allow-other-keys"]] + [&optional ["&aux" &rest + &or (symbolp &optional def-form) symbolp]] + ))) +;; Add missing declaration. +(def-edebug-spec cl-type-spec sexp) ;; This is not exactly correct but good + ;; enough. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support for `testcover' @@ -129,9 +144,9 @@ (setq testcover-module-constants (delq nil (mapcar - (lambda (sym) - (if (not (plist-member (symbol-plist sym) 'standard-value)) - sym)) + #'(lambda (sym) + (if (not (plist-member (symbol-plist sym) 'standard-value)) + sym)) testcover-module-constants))))) (defun rst-testcover-add-compose (fun) @@ -144,70 +159,73 @@ (when (boundp 'testcover-1value-functions) (add-to-list 'testcover-1value-functions fun))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Common Lisp stuff +;; Helpers. -;; Only use of macros is allowed - may be replaced by `cl-lib' some time. -(eval-when-compile - (require 'cl)) +(cl-defmacro rst-destructuring-dolist + ((arglist list &optional result) &rest body) + "`cl-dolist' with destructuring of the list elements. +ARGLIST is a Common List argument list which may include +destructuring. LIST, RESULT and BODY are as for `cl-dolist'. +Note that definitions in ARGLIST are visible only in the BODY and +neither in RESULT nor in LIST." + ;; FIXME: It would be very useful if the definitions in ARGLIST would be + ;; visible in RESULT. But may be this is rather a + ;; `rst-destructuring-do' then. + (declare (debug + (&define ([&or symbolp cl-macro-list] def-form &optional def-form) + cl-declarations def-body)) + (indent 1)) + (let ((var (make-symbol "--rst-destructuring-dolist-var--"))) + `(cl-dolist (,var ,list ,result) + (cl-destructuring-bind ,arglist ,var + ,@body)))) -;; Redefine some functions from `cl.el' in a proper namespace until they may be -;; used from there. - -(defun rst-signum (x) +(defun rst-forward-line-strict (n &optional limit) ;; testcover: ok. - "Return 1 if X is positive, -1 if negative, 0 if zero." - (cond - ((> x 0) 1) - ((< x 0) -1) - (t 0))) + "Try to move point to beginning of line I + N where I is the current line. +Return t if movement is successful. Otherwise don't move point +and return nil. If a position is given by LIMIT, movement +happened but the following line is missing and thus its beginning +can not be reached but the movement reached at least LIMIT +consider this a successful movement. LIMIT is ignored in other +cases." + (let ((start (point))) + (if (and (zerop (forward-line n)) + (or (bolp) + (and limit + (>= (point) limit)))) + t + (goto-char start) + nil))) -(defun rst-some (seq &optional pred) +(defun rst-forward-line-looking-at (n rst-re-args &optional fun) ;; testcover: ok. - "Return non-nil if any element of SEQ yields non-nil when PRED is applied. -Apply PRED to each element of list SEQ until the first non-nil -result is yielded and return this result. PRED defaults to -`identity'." - (unless pred - (setq pred 'identity)) - (catch 'rst-some - (dolist (elem seq) - (let ((r (funcall pred elem))) - (when r - (throw 'rst-some r)))))) + "Move forward N lines and if successful check whether RST-RE-ARGS is matched. +Moving forward is done by `rst-forward-line-strict'. RST-RE-ARGS +is a single or a list of arguments for `rst-re'. FUN is a +function defaulting to `identity' which is called after the call +to `looking-at' receiving its return value as the first argument. +When FUN is called match data is just set by `looking-at' and +point is at the beginning of the line. Return nil if moving +forward failed or otherwise the return value of FUN. Preserve +global match data, point, mark and current buffer." + (unless (listp rst-re-args) + (setq rst-re-args (list rst-re-args))) + (unless fun + (setq fun #'identity)) + (save-match-data + (save-excursion + (when (rst-forward-line-strict n) + (funcall fun (looking-at (apply #'rst-re rst-re-args))))))) -(defun rst-position-if (pred seq) - ;; testcover: ok. - "Return position of first element satisfying PRED in list SEQ or nil." - (catch 'rst-position-if - (let ((i 0)) - (dolist (elem seq) - (when (funcall pred elem) - (throw 'rst-position-if i)) - (incf i))))) +(rst-testcover-add-1value 'rst-delete-entire-line) +(defun rst-delete-entire-line (n) + "Move N lines and delete the entire line." + (delete-region (line-beginning-position (+ n 1)) + (line-beginning-position (+ n 2)))) -(defun rst-position (elem seq) - ;; testcover: ok. - "Return position of ELEM in list SEQ or nil. -Comparison done with `equal'." - ;; Create a closure containing `elem' so the `lambda' always sees our - ;; parameter instead of an `elem' which may be in dynamic scope at the time - ;; of execution of the `lambda'. - (lexical-let ((elem elem)) - (rst-position-if (function (lambda (e) - (equal elem e))) - seq))) - -(defun rst-member-if (pred seq) - ;; testcover: ok. - "Return sublist of SEQ starting with the element whose car satisfies PRED." - (let (found) - (while (and (not found) seq) - (if (funcall pred (car seq)) - (setq found seq) - (setq seq (cdr seq)))) - found)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Versions @@ -226,7 +244,7 @@ ;; 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.599 2016/07/31 11:13:12 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.1058.2.2 2017/01/03 21:56:09 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -251,7 +269,7 @@ ;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.5.0 %") + "%OfficialVersion: 1.5.1 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " @@ -277,7 +295,8 @@ ("1.4.0" . "24.3") ("1.4.1" . "24.5") ("1.4.2" . "24.5") - ("1.5.0" . "25.2") + ("1.5.0" . "26.1") + ("1.5.1" . "26.2") )) (unless (assoc rst-official-version rst-package-emacs-version-alist) @@ -292,7 +311,7 @@ ;; Initialize customization (defgroup rst nil "Support for reStructuredText documents." - :group 'wp + :group 'text :version "23.1" :link '(url-link "http://docutils.sourceforge.net/rst.html")) @@ -368,6 +387,7 @@ ;; Various starts (bul-sta bul-tag bli-sfx) ; Start of a bulleted item. + (bul-beg lin-beg bul-sta) ; A bullet item at the beginning of a line. ;; Explicit markup tag (`exm') (exm-tag "\\.\\.") @@ -571,34 +591,34 @@ After interpretation of ARGS the results are concatenated as for `:seq'." - (apply 'concat + (apply #'concat (mapcar - (lambda (re) - (cond - ((stringp re) - re) - ((symbolp re) - (cadr (assoc re rst-re-alist))) - ((characterp re) - (regexp-quote (char-to-string re))) - ((listp re) - (let ((nested - (mapcar (lambda (elt) - (rst-re elt)) - (cdr re)))) - (cond - ((eq (car re) :seq) - (mapconcat 'identity nested "")) - ((eq (car re) :shy) - (concat "\\(?:" (mapconcat 'identity nested "") "\\)")) - ((eq (car re) :grp) - (concat "\\(" (mapconcat 'identity nested "") "\\)")) - ((eq (car re) :alt) - (concat "\\(?:" (mapconcat 'identity nested "\\|") "\\)")) - (t - (error "Unknown list car: %s" (car re)))))) - (t - (error "Unknown object type for building regex: %s" re)))) + #'(lambda (re) + (cond + ((stringp re) + re) + ((symbolp re) + (cadr (assoc re rst-re-alist))) + ((characterp re) + (regexp-quote (char-to-string re))) + ((listp re) + (let ((nested + (mapcar (lambda (elt) + (rst-re elt)) + (cdr re)))) + (cond + ((eq (car re) :seq) + (mapconcat #'identity nested "")) + ((eq (car re) :shy) + (concat "\\(?:" (mapconcat #'identity nested "") "\\)")) + ((eq (car re) :grp) + (concat "\\(" (mapconcat #'identity nested "") "\\)")) + ((eq (car re) :alt) + (concat "\\(?:" (mapconcat #'identity nested "\\|") "\\)")) + (t + (error "Unknown list car: %s" (car re)))))) + (t + (error "Unknown object type for building regex: %s" re)))) args))) ;; FIXME: Remove circular dependency between `rst-re' and `rst-re-alist'. @@ -610,7 +630,7 @@ (dolist (re rst-re-alist-def rst-re-alist) (setq rst-re-alist (nconc rst-re-alist - (list (list (car re) (apply 'rst-re (cdr re)))))))) + (list (list (car re) (apply #'rst-re (cdr re)))))))) "Alist mapping symbols from `rst-re-alist-def' to regex strings.")) @@ -623,16 +643,16 @@ ;; ;; In addition a reStructuredText section header in the buffer is called ;; "section". -;; +;; ;; For lists a "s" is added to the name of the concepts. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Class rst-Ado -(defstruct +(cl-defstruct (rst-Ado - (:constructor nil) ;; Prevent creating unchecked values. + (:constructor nil) ; Prevent creating unchecked values. ;; Construct a transition. (:constructor rst-Ado-new-transition @@ -682,61 +702,45 @@ ;; testcover: ok. "Validate CHAR to be a valid adornment character. Return CHAR if so or signal an error otherwise." - (cond - ((not (characterp char)) - (signal 'wrong-type-argument (list 'characterp char))) - ((memq char rst-adornment-chars) - char) - (t - (signal 'args-out-of-range - (list (format - "Character must be a valid adornment character, not '%s'" - char)))))) + (cl-check-type char character) + (cl-check-type char (satisfies + (lambda (c) + (memq c rst-adornment-chars))) + "Character must be a valid adornment character") + char) ;; Public methods (defun rst-Ado-is-transition (self) ;; testcover: ok. "Return non-nil if SELF is a transition adornment." - (unless (rst-Ado-p self) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) + (cl-check-type self rst-Ado) (eq (rst-Ado--style self) 'transition)) (defun rst-Ado-is-section (self) ;; testcover: ok. "Return non-nil if SELF is a section adornment." - (unless (rst-Ado-p self) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) + (cl-check-type self rst-Ado) (not (rst-Ado-is-transition self))) (defun rst-Ado-is-simple (self) ;; testcover: ok. "Return non-nil if SELF is a simple section adornment." - (unless (rst-Ado-p self) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) + (cl-check-type self rst-Ado) (eq (rst-Ado--style self) 'simple)) (defun rst-Ado-is-over-and-under (self) ;; testcover: ok. "Return non-nil if SELF is a over-and-under section adornment." - (unless (rst-Ado-p self) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) + (cl-check-type self rst-Ado) (eq (rst-Ado--style self) 'over-and-under)) (defun rst-Ado-equal (self other) ;; testcover: ok. "Return non-nil when SELF and OTHER are equal." + (cl-check-type self rst-Ado) + (cl-check-type other rst-Ado) (cond - ((not (rst-Ado-p self)) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) - ((not (rst-Ado-p other)) - (signal 'wrong-type-argument - (list 'rst-Ado-p other))) ((not (eq (rst-Ado--style self) (rst-Ado--style other))) nil) ((rst-Ado-is-transition self)) @@ -744,22 +748,19 @@ (defun rst-Ado-position (self ados) ;; testcover: ok. - "Return position of of SELF in ADOS or nil." - (unless (rst-Ado-p self) - (signal 'wrong-type-argument - (list 'rst-Ado-p self))) - (lexical-let ((ado self)) ;; Create closure. - (rst-position-if (function (lambda (e) - (rst-Ado-equal ado e))) - ados))) + "Return position of SELF in ADOS or nil." + (cl-check-type self rst-Ado) + (cl-position-if #'(lambda (e) + (rst-Ado-equal self e)) + ados)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Class rst-Hdr -(defstruct +(cl-defstruct (rst-Hdr - (:constructor nil) ;; Prevent creating unchecked values. + (:constructor nil) ; Prevent creating unchecked values. ;; Construct while all parameters must be valid. (:constructor rst-Hdr-new @@ -784,7 +785,7 @@ &aux (ado (rst-Hdr--validate-ado (rst-Ado-new-invert ado-arg))) (indent (rst-Hdr--validate-indent indent-arg ado t)))) - (:copier rst-Hdr-copy)) ;; Not really needed for an immutable type. + (:copier nil)) ; Not really needed for an immutable type. "Representation of reStructuredText section header characteristics. This type is immutable." @@ -800,10 +801,8 @@ "Validate INDENT to be a valid indentation for ADO. Return INDENT if so or signal an error otherwise. If LAX don't signal an error and return a valid indent." + (cl-check-type indent integer) (cond - ((not (integerp indent)) - (signal 'wrong-type-argument - (list 'integerp 'null indent))) ((zerop indent) indent) ((rst-Ado-is-simple ado) @@ -816,33 +815,34 @@ 0 (signal 'args-out-of-range '("Indentation must not be negative")))) - (indent))) ;; Implicitly over-and-under. + ;; Implicitly over-and-under. + (indent))) (defun rst-Hdr--validate-ado (ado) ;; testcover: ok. "Validate ADO to be a valid adornment. Return ADO if so or signal an error otherwise." + (cl-check-type ado rst-Ado) (cond - ((not (rst-Ado-p ado)) - (signal 'wrong-type-argument - (list 'rst-Ado-p ado))) ((rst-Ado-is-transition ado) (signal 'args-out-of-range '("Adornment for header must not be transition."))) - (t - ado))) + (ado))) ;; Public class methods +(defvar rst-preferred-adornments) ; Forward declaration. + (defun rst-Hdr-preferred-adornments () ;; testcover: ok. "Return preferred adornments as list of `rst-Hdr'." - (mapcar (lambda (el) - (rst-Hdr-new-lax - (if (eq (cadr el) 'over-and-under) - (rst-Ado-new-over-and-under (car el)) - (rst-Ado-new-simple (car el))) - (caddr el))) + (mapcar (cl-function + (lambda ((character style indent)) + (rst-Hdr-new-lax + (if (eq style 'over-and-under) + (rst-Ado-new-over-and-under character) + (rst-Ado-new-simple character)) + indent))) rst-preferred-adornments)) ;; Public methods @@ -850,238 +850,238 @@ (defun rst-Hdr-member-ado (self hdrs) ;; testcover: ok. "Return sublist of HDRS whose car's adornment equals that of SELF or nil." - (unless (rst-Hdr-p self) - (signal 'wrong-type-argument - (list 'rst-Hdr-p self))) - (let ((pos (rst-Ado-position (rst-Hdr-ado self) (rst-Hdr-ado-map hdrs)))) - (and pos (nthcdr pos hdrs)))) + (cl-check-type self rst-Hdr) + (let ((ado (rst-Hdr-ado self))) + (cl-member-if #'(lambda (hdr) + (rst-Ado-equal ado (rst-Hdr-ado hdr))) + hdrs))) -(defun rst-Hdr-ado-map (selfs) +(defun rst-Hdr-ado-map (selves) ;; testcover: ok. - "Return `rst-Ado' list extracted from elements of SELFS." - (mapcar 'rst-Hdr-ado selfs)) + "Return `rst-Ado' list extracted from elements of SELVES." + (mapcar #'rst-Hdr-ado selves)) (defun rst-Hdr-get-char (self) ;; testcover: ok. "Return character of the adornment of SELF." - (unless (rst-Hdr-p self) - (signal 'wrong-type-argument - (list 'rst-Hdr-p self))) + (cl-check-type self rst-Hdr) (rst-Ado-char (rst-Hdr-ado self))) (defun rst-Hdr-is-over-and-under (self) ;; testcover: ok. "Return non-nil if SELF is a over-and-under section header." - (unless (rst-Hdr-p self) - (signal 'wrong-type-argument - (list 'rst-Hdr-p self))) + (cl-check-type self rst-Hdr) (rst-Ado-is-over-and-under (rst-Hdr-ado self))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Class rst-Ttl -(defstruct +(cl-defstruct (rst-Ttl - (:constructor nil) ;; Prevent creating unchecked values. + (:constructor nil) ; Prevent creating unchecked values. ;; Construct with valid parameters for all attributes. - (:constructor - rst-Ttl-new + (:constructor ; Private constructor + rst-Ttl--new (ado-arg match-arg indent-arg text-arg - &optional - hdr-arg - level-arg &aux (ado (rst-Ttl--validate-ado ado-arg)) (match (rst-Ttl--validate-match match-arg ado)) (indent (rst-Ttl--validate-indent indent-arg ado)) (text (rst-Ttl--validate-text text-arg ado)) - (hdr (and hdr-arg (rst-Ttl--validate-hdr hdr-arg ado indent))) - (level (and level-arg (rst-Ttl--validate-level level-arg))))) - (:copier rst-Ttl-copy)) - "Representation of a reStructuredText section header as found in the buffer. -This type gathers information about an adorned part in the -buffer. Thus only the basic attributes are immutable. Although -the remaining attributes are `setf'-able the respective setters -should be used." + (hdr (condition-case nil + (rst-Hdr-new ado indent) + (error nil))))) + (:copier nil)) ; Not really needed for an immutable type. + "Representation of a reStructuredText section header as found in a buffer. +This type gathers information about an adorned part in the buffer. + +This type is immutable." ;; The adornment characteristics or nil for a title candidate. (ado nil :read-only t) - ;; The match-data for `ado' as returned by `match-data'. Match group 0 - ;; matches the whole construct. Match group 1 matches the overline adornment - ;; if present. Match group 2 matches the section title text or the - ;; transition. Match group 3 matches the underline adornment. + ;; The match-data for `ado' in a form similarly returned by `match-data' (but + ;; not necessarily with markers in buffers). Match group 0 matches the whole + ;; construct. Match group 1 matches the overline adornment if present. + ;; Match group 2 matches the section title text or the transition. Match + ;; group 3 matches the underline adornment. (match nil :read-only t) ;; An indentation found for the title line or nil for a transition. (indent nil :read-only t) ;; The text of the title or nil for a transition. (text nil :read-only t) ;; The header characteristics if it is a valid section header. - (hdr nil) - ;; The hierarchical level of the section header starting with 0. - (level nil)) + (hdr nil :read-only t) + ;; FIXME refactoring: Should have an attribute `buffer' for the buffer this + ;; title is found in. This breaks lots and lots of tests. + ;; However, with private constructor they may not be + ;; necessary any more. In case it is really a buffer then + ;; also `match' could be real data from `match-data' which + ;; contains markers instead of integers. + ) ;; Private class methods (defun rst-Ttl--validate-ado (ado) ;; testcover: ok. "Return valid ADO or signal error." - (unless (or (null ado) (rst-Ado-p ado)) - (signal 'wrong-type-argument - (list 'null 'rst-Ado-p ado))) + (cl-check-type ado (or null rst-Ado)) ado) (defun rst-Ttl--validate-match (match ado) ;; testcover: ok. "Return valid MATCH matching ADO or signal error." - (unless (listp match) - (signal 'wrong-type-argument - (list 'listp match))) - (unless (equal (length match) 8) - (signal 'args-out-of-range - '("Match data must consist of exactly 8 buffer positions."))) - (mapcar (lambda (pos) - (unless (or (null pos) (integer-or-marker-p pos)) - (signal 'wrong-type-argument - (list 'integer-or-marker-p 'null pos)))) - match) - (unless (and (integer-or-marker-p (nth 0 match)) - (integer-or-marker-p (nth 1 match))) - (signal 'args-out-of-range - '("First two elements of match data must be buffer positions."))) - (cond - ((null ado) - (unless (and (null (nth 2 match)) - (null (nth 3 match)) - (integer-or-marker-p (nth 4 match)) - (integer-or-marker-p (nth 5 match)) - (null (nth 6 match)) - (null (nth 7 match))) + (cl-check-type ado (or null rst-Ado)) + (cl-check-type match list) + (cl-check-type match (satisfies (lambda (m) + (equal (length m) 8))) + "Match data must consist of exactly 8 buffer positions.") + (dolist (pos match) + (cl-check-type pos (or null integer-or-marker))) + (cl-destructuring-bind (all-beg all-end + ovr-beg ovr-end + txt-beg txt-end + und-beg und-end) match + (unless (and (integer-or-marker-p all-beg) (integer-or-marker-p all-end)) (signal 'args-out-of-range - '("For a title candidate exactly the third match pair must be set.")))) - ((rst-Ado-is-transition ado) - (unless (and (null (nth 2 match)) - (null (nth 3 match)) - (integer-or-marker-p (nth 4 match)) - (integer-or-marker-p (nth 5 match)) - (null (nth 6 match)) - (null (nth 7 match))) - (signal 'args-out-of-range - '("For a transition exactly the third match pair must be set.")))) - ((rst-Ado-is-simple ado) - (unless (and (null (nth 2 match)) - (null (nth 3 match)) - (integer-or-marker-p (nth 4 match)) - (integer-or-marker-p (nth 5 match)) - (integer-or-marker-p (nth 6 match)) - (integer-or-marker-p (nth 7 match))) - (signal 'args-out-of-range - '("For a simple section adornment exactly the third and fourth match pair must be set.")))) - (t ;; over-and-under - (unless (and (integer-or-marker-p (nth 2 match)) - (integer-or-marker-p (nth 3 match)) - (integer-or-marker-p (nth 4 match)) - (integer-or-marker-p (nth 5 match)) - (or (null (nth 6 match)) (integer-or-marker-p (nth 6 match))) - (or (null (nth 7 match)) (integer-or-marker-p (nth 7 match)))) - (signal 'args-out-of-range - '("For a over-and-under section adornment all match pairs must be set."))))) + '("First two elements of match data must be buffer positions."))) + (cond + ((null ado) + (unless (and (null ovr-beg) (null ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (null und-beg) (null und-end)) + (signal 'args-out-of-range + '("For a title candidate exactly the third match pair must be set.")))) + ((rst-Ado-is-transition ado) + (unless (and (null ovr-beg) (null ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (null und-beg) (null und-end)) + (signal 'args-out-of-range + '("For a transition exactly the third match pair must be set.")))) + ((rst-Ado-is-simple ado) + (unless (and (null ovr-beg) (null ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (integer-or-marker-p und-beg) (integer-or-marker-p und-end)) + (signal 'args-out-of-range + '("For a simple section adornment exactly the third and fourth match pair must be set.")))) + (t ; over-and-under + (unless (and (integer-or-marker-p ovr-beg) (integer-or-marker-p ovr-end) + (integer-or-marker-p txt-beg) (integer-or-marker-p txt-end) + (or (null und-beg) (integer-or-marker-p und-beg)) + (or (null und-end) (integer-or-marker-p und-end))) + (signal 'args-out-of-range + '("For a over-and-under section adornment all match pairs must be set.")))))) match) (defun rst-Ttl--validate-indent (indent ado) ;; testcover: ok. "Return valid INDENT for ADO or signal error." (if (and ado (rst-Ado-is-transition ado)) - (unless (null indent) - (signal 'args-out-of-range - '("Indent for a transition must be nil."))) - (unless (integerp indent) - (signal 'wrong-type-argument - (list 'integerp indent))) - (unless (>= indent 0) - (signal 'args-out-of-range - '("Indent for a section header must be non-negative.")))) + (cl-check-type indent null + "Indent for a transition must be nil.") + (cl-check-type indent (integer 0 *) + "Indent for a section header must be non-negative.")) indent) -(defun rst-Ttl--validate-hdr (hdr ado indent) - ;; testcover: ok. - "Return valid HDR in relation to ADO and INDENT or signal error." - (unless (rst-Hdr-p hdr) - (signal 'wrong-type-argument - (list 'rst-Hdr-p hdr))) - (unless (rst-Ado-equal (rst-Hdr-ado hdr) ado) - (signal 'args-out-of-range - '("Basic adornment and adornment in header must match."))) - (unless (equal (rst-Hdr-indent hdr) indent) - (signal 'args-out-of-range - '("Basic indent and indent in header must match."))) - hdr) - (defun rst-Ttl--validate-text (text ado) ;; testcover: ok. "Return valid TEXT for ADO or signal error." (if (and ado (rst-Ado-is-transition ado)) - (unless (null text) - (signal 'args-out-of-range - '("Transitions may not have title text."))) - (unless (stringp text) - (signal 'wrong-type-argument - (list 'stringp text)))) + (cl-check-type text null + "Transitions may not have title text.") + (cl-check-type text string)) text) -(defun rst-Ttl--validate-level (level) +;; Public class methods + +(defun rst-Ttl-from-buffer (ado beg-ovr beg-txt beg-und txt) ;; testcover: ok. - "Return valid LEVEL or signal error." - (unless (integerp level) - (signal 'wrong-type-argument - (list 'integerp level))) - (unless (>= level 0) - (signal 'args-out-of-range - '("Level must be non-negative."))) - level) + "Return a `rst-Ttl' constructed from information in the current buffer. +ADO is the adornment or nil for a title candidate. BEG-OVR and +BEG-UND are the starting points of the overline or underline, +respectively. They may be nil if the respective thing is missing. +BEG-TXT is the beginning of the title line or the transition and +must be given. The end of the line is used as the end point. TXT +is the title text or nil. If TXT is given the indendation of the +line containing BEG-TXT is used as indentation. Match group 0 is +derived from the remaining information." + (cl-check-type beg-txt integer-or-marker) + (save-excursion + (let ((end-ovr (when beg-ovr + (goto-char beg-ovr) + (line-end-position))) + (end-txt (progn + (goto-char beg-txt) + (line-end-position))) + (end-und (when beg-und + (goto-char beg-und) + (line-end-position))) + (ind (when txt + (goto-char beg-txt) + (current-indentation)))) + (rst-Ttl--new ado + (list + (or beg-ovr beg-txt) (or end-und end-txt) + beg-ovr end-ovr + beg-txt end-txt + beg-und end-und) + ind txt)))) ;; Public methods -(defun rst-Ttl-evaluate-hdr (self) - ;; testcover: ok. - "Check for `ado' and `indent' in SELF forming a valid `rst-Hdr'. -Set and return it or nil if no valid `rst-Hdr' can be formed." - (setf (rst-Ttl-hdr self) - (condition-case nil - (rst-Hdr-new (rst-Ttl-ado self) (rst-Ttl-indent self)) - (error nil)))) - -(defun rst-Ttl-set-level (self level) - ;; testcover: ok. - "In SELF set and return LEVEL or nil if invalid." - (setf (rst-Ttl-level self) - (rst-Ttl--validate-level level))) - (defun rst-Ttl-get-title-beginning (self) ;; testcover: ok. "Return position of beginning of title text of SELF. This position should always be at the start of a line." + (cl-check-type self rst-Ttl) (nth 4 (rst-Ttl-match self))) (defun rst-Ttl-get-beginning (self) ;; testcover: ok. "Return position of beginning of whole SELF." + (cl-check-type self rst-Ttl) (nth 0 (rst-Ttl-match self))) (defun rst-Ttl-get-end (self) ;; testcover: ok. "Return position of end of whole SELF." + (cl-check-type self rst-Ttl) (nth 1 (rst-Ttl-match self))) +(defun rst-Ttl-is-section (self) + ;; testcover: ok. + "Return non-nil if SELF is a section header or candidate." + (cl-check-type self rst-Ttl) + (rst-Ttl-text self)) + +(defun rst-Ttl-is-candidate (self) + ;; testcover: ok. + "Return non-nil if SELF is a candidate for a section header." + (cl-check-type self rst-Ttl) + (not (rst-Ttl-ado self))) + +(defun rst-Ttl-contains (self position) + "Return whether SELF contain POSITION. +Return 0 if SELF contains POSITION, < 0 if SELF ends before +POSITION and > 0 if SELF starts after position." + (cl-check-type self rst-Ttl) + (cl-check-type position integer-or-marker) + (cond + ((< (nth 1 (rst-Ttl-match self)) position) + -1) + ((> (nth 0 (rst-Ttl-match self)) position) + +1) + (0))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Class rst-Stn -(defstruct +(cl-defstruct (rst-Stn - (:constructor nil) ;; Prevent creating unchecked values. + (:constructor nil) ; Prevent creating unchecked values. ;; Construct while all parameters must be valid. (:constructor rst-Stn-new @@ -1102,45 +1102,33 @@ (level nil :read-only t) ;; The list of children of the node. (children nil :read-only t)) +;; FIXME refactoring: Should have an attribute `buffer' for the buffer this +;; title is found in. Or use `rst-Ttl-buffer'. ;; Private class methods (defun rst-Stn--validate-ttl (ttl) ;; testcover: ok. "Return valid TTL or signal error." - (unless (or (null ttl) (rst-Ttl-p ttl)) - (signal 'wrong-type-argument - (list 'null 'rst-Ttl-p ttl))) + (cl-check-type ttl (or null rst-Ttl)) ttl) (defun rst-Stn--validate-level (level ttl) ;; testcover: ok. "Return valid LEVEL for TTL or signal error." - (unless (integerp level) - (signal 'wrong-type-argument - (list 'integerp level))) - (when ttl - (unless (or (not (rst-Ttl-level ttl)) - (equal (rst-Ttl-level ttl) level)) - (signal 'args-out-of-range - '("A title must have correct level or none at all."))) - (when (< level 0) - ;; testcover: Never reached because a title may not have a negative level - (signal 'args-out-of-range - '("Top level node must not have a title.")))) + (cl-check-type level integer) + (when (and ttl (< level 0)) + ;; testcover: Never reached because a title may not have a negative level + (signal 'args-out-of-range + '("Top level node must not have a title."))) level) (defun rst-Stn--validate-children (children ttl) ;; testcover: ok. "Return valid CHILDREN for TTL or signal error." - (unless (listp children) - (signal 'wrong-type-argument - (list 'listp children))) - (mapcar (lambda (child) - (unless (rst-Stn-p child) - (signal 'wrong-type-argument - (list 'rst-Stn-p child)))) - children) + (cl-check-type children list) + (dolist (child children) + (cl-check-type child rst-Stn)) (unless (or ttl children) (signal 'args-out-of-range '("A missing node must have children."))) @@ -1152,9 +1140,7 @@ ;; testcover: ok. "Return the beginning of the title of SELF. Handles missing node properly." - (unless (rst-Stn-p self) - (signal 'wrong-type-argument - (list 'rst-Stn-p self))) + (cl-check-type self rst-Stn) (let ((ttl (rst-Stn-ttl self))) (if ttl (rst-Ttl-get-title-beginning ttl) @@ -1164,9 +1150,7 @@ ;; testcover: ok. "Return title text of SELF or DEFAULT if SELF is a missing node. For a missing node and no DEFAULT given return a standard title text." - (unless (rst-Stn-p self) - (signal 'wrong-type-argument - (list 'rst-Stn-p self))) + (cl-check-type self rst-Stn) (let ((ttl (rst-Stn-ttl self))) (cond (ttl @@ -1177,9 +1161,7 @@ (defun rst-Stn-is-top (self) ;; testcover: ok. "Return non-nil if SELF is a top level node." - (unless (rst-Stn-p self) - (signal 'wrong-type-argument - (list 'rst-Stn-p self))) + (cl-check-type self rst-Stn) (< (rst-Stn-level self) 0)) @@ -1203,13 +1185,13 @@ (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)))) + (lambda () + (interactive) + (call-interactively def) + (message "[Deprecated use of key %s; use key %s instead]" + (key-description (this-command-keys)) + (key-description key))) + ;; FIXME: In Emacs-25 we could use (:documentation ...) instead. (format "Deprecated binding for %s, use \\[%s] instead." def def))) (dolist (dep-key deprecated) @@ -1220,40 +1202,40 @@ (let ((map (make-sparse-keymap))) ;; \C-c is the general keymap. - (rst-define-key map [?\C-c ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-h] #'describe-prefix-bindings) ;; ;; Section Adornments ;; ;; 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 and - ; on consoles. + (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 macOS 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) + (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) + (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-hdr-hierarchy) + (rst-define-key map [?\C-c ?\C-a ?\C-d] #'rst-display-hdr-hierarchy) ;; Homogenize the adornments in the document. - (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-sections + (rst-define-key map [?\C-c ?\C-a ?\C-s] #'rst-straighten-sections [?\C-c ?\C-s]) ;; ;; Section Movement and Selection ;; ;; Mark the subsection where the cursor is. - (rst-define-key map [?\C-\M-h] 'rst-mark-section + (rst-define-key map [?\C-\M-h] #'rst-mark-section ;; Same as mark-defun sgml-mark-current-element. [?\C-c ?\C-m]) ;; Move backward/forward between section titles. ;; FIXME: Also bind similar to outline mode. - (rst-define-key map [?\C-\M-a] 'rst-backward-section + (rst-define-key map [?\C-\M-a] #'rst-backward-section ;; Same as beginning-of-defun. [?\C-c ?\C-n]) - (rst-define-key map [?\C-\M-e] 'rst-forward-section + (rst-define-key map [?\C-\M-e] #'rst-forward-section ;; Same as end-of-defun. [?\C-c ?\C-p]) @@ -1261,69 +1243,69 @@ ;; Operating on regions ;; ;; \C-c \C-r is the keymap for regions. - (rst-define-key map [?\C-c ?\C-r ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-r ?\C-h] #'describe-prefix-bindings) ;; Makes region a line-block. - (rst-define-key map [?\C-c ?\C-r ?\C-l] 'rst-line-block-region + (rst-define-key map [?\C-c ?\C-r ?\C-l] #'rst-line-block-region [?\C-c ?\C-d]) ;; Shift region left or right according to tabs. - (rst-define-key map [?\C-c ?\C-r tab] 'rst-shift-region + (rst-define-key map [?\C-c ?\C-r tab] #'rst-shift-region [?\C-c ?\C-r t] [?\C-c ?\C-l t]) ;; ;; Operating on lists ;; ;; \C-c \C-l is the keymap for lists. - (rst-define-key map [?\C-c ?\C-l ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-l ?\C-h] #'describe-prefix-bindings) ;; Makes paragraphs in region as a bullet list. - (rst-define-key map [?\C-c ?\C-l ?\C-b] 'rst-bullet-list-region + (rst-define-key map [?\C-c ?\C-l ?\C-b] #'rst-bullet-list-region [?\C-c ?\C-b]) ;; Makes paragraphs in region as a enumeration. - (rst-define-key map [?\C-c ?\C-l ?\C-e] 'rst-enumerate-region + (rst-define-key map [?\C-c ?\C-l ?\C-e] #'rst-enumerate-region [?\C-c ?\C-e]) ;; Converts bullets to an enumeration. - (rst-define-key map [?\C-c ?\C-l ?\C-c] 'rst-convert-bullets-to-enumeration + (rst-define-key map [?\C-c ?\C-l ?\C-c] #'rst-convert-bullets-to-enumeration [?\C-c ?\C-v]) ;; Make sure that all the bullets in the region are consistent. - (rst-define-key map [?\C-c ?\C-l ?\C-s] 'rst-straighten-bullets-region + (rst-define-key map [?\C-c ?\C-l ?\C-s] #'rst-straighten-bullets-region [?\C-c ?\C-w]) ;; Insert a list item. - (rst-define-key map [?\C-c ?\C-l ?\C-i] 'rst-insert-list) + (rst-define-key map [?\C-c ?\C-l ?\C-i] #'rst-insert-list) ;; ;; Table-of-Contents Features ;; ;; \C-c \C-t is the keymap for table of contents. - (rst-define-key map [?\C-c ?\C-t ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-t ?\C-h] #'describe-prefix-bindings) ;; Enter a TOC buffer to view and move to a specific section. - (rst-define-key map [?\C-c ?\C-t ?\C-t] 'rst-toc) + (rst-define-key map [?\C-c ?\C-t ?\C-t] #'rst-toc) ;; Insert a TOC here. - (rst-define-key map [?\C-c ?\C-t ?\C-i] 'rst-toc-insert + (rst-define-key map [?\C-c ?\C-t ?\C-i] #'rst-toc-insert [?\C-c ?\C-i]) ;; Update the document's TOC (without changing the cursor position). - (rst-define-key map [?\C-c ?\C-t ?\C-u] 'rst-toc-update + (rst-define-key map [?\C-c ?\C-t ?\C-u] #'rst-toc-update [?\C-c ?\C-u]) - ;; Go to the section under the cursor (cursor must be in TOC). - (rst-define-key map [?\C-c ?\C-t ?\C-j] 'rst-goto-section + ;; Go to the section under the cursor (cursor must be in internal TOC). + (rst-define-key map [?\C-c ?\C-t ?\C-j] #'rst-toc-follow-link [?\C-c ?\C-f]) ;; ;; Converting Documents from Emacs ;; ;; \C-c \C-c is the keymap for compilation. - (rst-define-key map [?\C-c ?\C-c ?\C-h] 'describe-prefix-bindings) + (rst-define-key map [?\C-c ?\C-c ?\C-h] #'describe-prefix-bindings) ;; Run one of two pre-configured toolset commands on the document. - (rst-define-key map [?\C-c ?\C-c ?\C-c] 'rst-compile + (rst-define-key map [?\C-c ?\C-c ?\C-c] #'rst-compile [?\C-c ?1]) - (rst-define-key map [?\C-c ?\C-c ?\C-a] 'rst-compile-alt-toolset + (rst-define-key map [?\C-c ?\C-c ?\C-a] #'rst-compile-alt-toolset [?\C-c ?2]) ;; Convert the active region to pseudo-xml using the docutils tools. - (rst-define-key map [?\C-c ?\C-c ?\C-x] 'rst-compile-pseudo-region + (rst-define-key map [?\C-c ?\C-c ?\C-x] #'rst-compile-pseudo-region [?\C-c ?3]) ;; Convert the current document to PDF and launch a viewer on the results. - (rst-define-key map [?\C-c ?\C-c ?\C-p] 'rst-compile-pdf-preview + (rst-define-key map [?\C-c ?\C-c ?\C-p] #'rst-compile-pdf-preview [?\C-c ?4]) ;; Convert the current document to S5 slides and view in a web browser. - (rst-define-key map [?\C-c ?\C-c ?\C-s] 'rst-compile-slides-preview + (rst-define-key map [?\C-c ?\C-c ?\C-s] #'rst-compile-slides-preview [?\C-c ?5]) map) @@ -1333,7 +1315,8 @@ ;; Abbrevs. (define-abbrev-table 'rst-mode-abbrev-table - (mapcar (lambda (x) (append x '(nil 0 system))) + (mapcar #'(lambda (x) + (append x '(nil 0 system))) '(("contents" ".. contents::\n..\n ") ("con" ".. contents::\n..\n ") ("cont" "[...]") @@ -1381,6 +1364,7 @@ (require 'newcomment) (defvar electric-pair-pairs) +(defvar electric-indent-inhibit) ;; 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. @@ -1411,10 +1395,10 @@ (:seq hws-tag par-tag- bli-sfx)))) ;; Indenting and filling. - (setq-local indent-line-function 'rst-indent-line) + (setq-local indent-line-function #'rst-indent-line) (setq-local adaptive-fill-mode t) (setq-local adaptive-fill-regexp (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) - (setq-local adaptive-fill-function 'rst-adaptive-fill) + (setq-local adaptive-fill-function #'rst-adaptive-fill) (setq-local fill-paragraph-handle-comment nil) ;; Comments. @@ -1430,18 +1414,18 @@ ;; Commenting in reStructuredText is very special so use our own set of ;; functions. - (setq-local comment-line-break-function 'rst-comment-line-break) - (setq-local comment-indent-function 'rst-comment-indent) - (setq-local comment-insert-comment-function 'rst-comment-insert-comment) - (setq-local comment-region-function 'rst-comment-region) - (setq-local uncomment-region-function 'rst-uncomment-region) + (setq-local comment-line-break-function #'rst-comment-line-break) + (setq-local comment-indent-function #'rst-comment-indent) + (setq-local comment-insert-comment-function #'rst-comment-insert-comment) + (setq-local comment-region-function #'rst-comment-region) + (setq-local uncomment-region-function #'rst-uncomment-region) (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) ;; Imenu and which function. ;; FIXME: Check documentation of `which-function' for alternative ways to ;; determine the current function name. - (setq-local imenu-create-index-function 'rst-imenu-create-index) + (setq-local imenu-create-index-function #'rst-imenu-create-index) ;; Font lock. (setq-local font-lock-defaults @@ -1449,7 +1433,7 @@ t nil nil nil (font-lock-multiline . t) (font-lock-mark-block-function . mark-paragraph))) - (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t) + (add-hook 'font-lock-extend-region-functions #'rst-font-lock-extend-region t) ;; Text after a changed line may need new fontification. (setq-local jit-lock-contextually t) @@ -1562,9 +1546,9 @@ :type `(repeat (group :tag "Adornment specification" (choice :tag "Adornment character" - ,@(mapcar (lambda (char) - (list 'const - :tag (char-to-string char) char)) + ,@(mapcar #'(lambda (char) + (list 'const + :tag (char-to-string char) char)) rst-adornment-chars)) (radio :tag "Adornment type" (const :tag "Overline and underline" over-and-under) @@ -1603,17 +1587,12 @@ ;; Start searching after the level of the previous adornment. (cdr (rst-Hdr-member-ado prev (rst-Hdr-preferred-adornments)))) (rst-Hdr-preferred-adornments)))) - (car - (rst-member-if (lambda (cand) - (not (rst-Hdr-member-ado cand seen))) - candidates)))) + (cl-find-if #'(lambda (cand) + (not (rst-Hdr-member-ado cand seen))) + candidates))) -(defun rst-delete-entire-line () - "Delete the entire current line without using the `kill-ring'." - (delete-region (line-beginning-position) - (line-beginning-position 2))) - (defun rst-update-section (hdr) + ;; testcover: ok. "Unconditionally update the style of the section header at point to HDR. If there are existing overline and/or underline from the existing adornment, they are removed before adding the @@ -1621,163 +1600,149 @@ (end-of-line) (let ((indent (or (rst-Hdr-indent hdr) 0)) (marker (point-marker)) - len) + new) ;; Fixup whitespace at the beginning and end of the line. - (beginning-of-line) + (1value + (rst-forward-line-strict 0)) (delete-horizontal-space) (insert (make-string indent ? )) - (end-of-line) (delete-horizontal-space) + (setq new (make-string (+ (current-column) indent) (rst-Hdr-get-char hdr))) - ;; Set the current column, we're at the end of the title line. - (setq len (+ (current-column) indent)) - ;; Remove previous line if it is an adornment. - (save-excursion - (forward-line -1) ;; FIXME testcover: Doesn't work when in first line of - ;; buffer. - (if (and (looking-at (rst-re 'ado-beg-2-1)) + ;; FIXME refactoring: Check whether this deletes `hdr' which *has* all the + ;; data necessary. + (when (and (rst-forward-line-looking-at -1 'ado-beg-2-1) ;; Avoid removing the underline of a title right above us. - (save-excursion (forward-line -1) - (not (looking-at (rst-re 'ttl-beg-1))))) - (rst-delete-entire-line))) + (not (rst-forward-line-looking-at -2 'ttl-beg-1))) + (rst-delete-entire-line -1)) ;; Remove following line if it is an adornment. - (save-excursion - (forward-line +1) ;; FIXME testcover: 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 unless it is the final - ;; empty line, for the subsequent inserting of the underline. - (if (and (= (point) (buffer-end 1)) (not (bolp))) - (newline 1))) + (when (rst-forward-line-looking-at +1 'ado-beg-2-1) + (rst-delete-entire-line +1)) + ;; Insert underline. + (unless (rst-forward-line-strict +1) + ;; Normalize buffer by adding final newline. + (newline 1)) + (open-line 1) + (insert new) + ;; Insert overline. (when (rst-Hdr-is-over-and-under hdr) - (save-excursion - (beginning-of-line) - (open-line 1) - (insert (make-string len (rst-Hdr-get-char hdr))))) + (1value ; Underline inserted above. + (rst-forward-line-strict -1)) + (open-line 1) + (insert new)) - ;; Insert underline. - (1value ;; Line has been inserted above. - (forward-line +1)) - (open-line 1) - (insert (make-string len (rst-Hdr-get-char hdr))) - - (1value ;; Line has been inserted above. - (forward-line +1)) (goto-char marker))) -(defun rst-classify-adornment (adornment end) +(defun rst-classify-adornment (adornment end &optional accept-over-only) + ;; testcover: ok. "Classify adornment string for section titles and transitions. ADORNMENT is the complete adornment string as found in the buffer with optional trailing whitespace. END is the point after the last character of ADORNMENT. Return a `rst-Ttl' or nil if no -syntactically valid adornment is found." +syntactically valid adornment is found. If ACCEPT-OVER-ONLY an +overline with a missing underline is accepted as valid and +returned." (save-excursion (save-match-data (when (string-match (rst-re 'ado-beg-2-1) adornment) (goto-char end) (let* ((ado-ch (string-to-char (match-string 2 adornment))) - (ado-re (rst-re ado-ch 'adorep3-hlp)) - (end-pnt (point)) + (ado-re (rst-re ado-ch 'adorep3-hlp)) ; RE matching the + ; adornment. (beg-pnt (progn - (1value ;; No lines may be left to move. - (forward-line 0)) + (1value + (rst-forward-line-strict 0)) (point))) (nxt-emp ; Next line nonexistent or empty - (save-excursion - (or (not (zerop (forward-line 1))) - ;; FIXME testcover: Add test classifying at the end of - ;; buffer. - (looking-at (rst-re 'lin-end))))) + (not (rst-forward-line-looking-at +1 'lin-end #'not))) (prv-emp ; Previous line nonexistent or empty - (save-excursion - (or (not (zerop (forward-line -1))) - (looking-at (rst-re 'lin-end))))) + (not (rst-forward-line-looking-at -1 'lin-end #'not))) txt-blw (ttl-blw ; Title found below starting here. - (save-excursion - (and - (zerop (forward-line 1)) ;; FIXME testcover: Add test - ;; classifying at the end of - ;; buffer. - (looking-at (rst-re 'ttl-beg-1)) - (setq txt-blw (match-string-no-properties 1)) - (point)))) + (rst-forward-line-looking-at + +1 'ttl-beg-1 + #'(lambda (mtcd) + (when mtcd + (setq txt-blw (match-string-no-properties 1)) + (point))))) txt-abv (ttl-abv ; Title found above starting here. - (save-excursion - (and - (zerop (forward-line -1)) - (looking-at (rst-re 'ttl-beg-1)) - (setq txt-abv (match-string-no-properties 1)) - (point)))) + (rst-forward-line-looking-at + -1 'ttl-beg-1 + #'(lambda (mtcd) + (when mtcd + (setq txt-abv (match-string-no-properties 1)) + (point))))) (und-fnd ; Matching underline found starting here. - (save-excursion - (and ttl-blw - (zerop (forward-line 2)) ;; FIXME testcover: Add test - ;; classifying at the end of - ;; buffer. - (looking-at (rst-re ado-re 'lin-end)) - (point)))) + (and ttl-blw + (rst-forward-line-looking-at + +2 (list ado-re 'lin-end) + #'(lambda (mtcd) + (when mtcd + (point)))))) (ovr-fnd ; Matching overline found starting here. - (save-excursion - (and ttl-abv - (zerop (forward-line -2)) - (looking-at (rst-re ado-re 'lin-end)) - (point)))) - ado ind txt beg-ovr end-ovr beg-txt end-txt beg-und end-und) + (and ttl-abv + (rst-forward-line-looking-at + -2 (list ado-re 'lin-end) + #'(lambda (mtcd) + (when mtcd + (point)))))) + (und-wng ; Wrong underline found starting here. + (and ttl-blw + (not und-fnd) + (rst-forward-line-looking-at + +2 'ado-beg-2-1 + #'(lambda (mtcd) + (when mtcd + (point)))))) + (ovr-wng ; Wrong overline found starting here. + (and ttl-abv (not ovr-fnd) + (rst-forward-line-looking-at + -2 'ado-beg-2-1 + #'(lambda (mtcd) + (when (and + mtcd + ;; An adornment above may be a legal + ;; adornment for the line above - consider it + ;; a wrong overline only when it is equally + ;; long. + (equal + (length (match-string-no-properties 1)) + (length adornment))) + (point))))))) (cond ((and nxt-emp prv-emp) ;; A transition. - (setq ado (rst-Ado-new-transition) - beg-txt beg-pnt - end-txt end-pnt)) - ((or und-fnd ovr-fnd) + (rst-Ttl-from-buffer (rst-Ado-new-transition) + nil beg-pnt nil nil)) + (ovr-fnd ; Prefer overline match over underline match. ;; An overline with an underline. - (setq ado (rst-Ado-new-over-and-under ado-ch)) - (let (;; Prefer overline match over underline match. - (und-pnt (if ovr-fnd beg-pnt und-fnd)) - (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt)) - (txt-pnt (if ovr-fnd ttl-abv ttl-blw))) - (goto-char ovr-pnt) - (setq beg-ovr (point) - end-ovr (line-end-position)) - (goto-char txt-pnt) - (setq beg-txt (point) - end-txt (line-end-position) - ind (current-indentation) - txt (if ovr-fnd txt-abv txt-blw)) - (goto-char und-pnt) - (setq beg-und (point) - end-und (line-end-position)))) - (ttl-abv + (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch) + ovr-fnd ttl-abv beg-pnt txt-abv)) + (und-fnd + ;; An overline with an underline. + (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch) + beg-pnt ttl-blw und-fnd txt-blw)) + ((and ttl-abv (not ovr-wng)) ;; An underline. - (setq ado (rst-Ado-new-simple ado-ch) - beg-und beg-pnt - end-und end-pnt) - (goto-char ttl-abv) - (setq beg-txt (point) - end-txt (line-end-position) - ind (current-indentation) - txt txt-abv)) + (rst-Ttl-from-buffer (rst-Ado-new-simple ado-ch) + nil ttl-abv beg-pnt txt-abv)) + ((and accept-over-only ttl-blw (not und-wng)) + ;; An overline with a missing underline. + (rst-Ttl-from-buffer (rst-Ado-new-over-and-under ado-ch) + beg-pnt ttl-blw nil txt-blw)) (t ;; Invalid adornment. - (setq ado nil))) - (if ado - (rst-Ttl-new ado - (list - (or beg-ovr beg-txt) - (or end-und end-txt) - beg-ovr end-ovr beg-txt end-txt beg-und end-und) - ind txt))))))) + nil))))))) (defun rst-ttl-at-point () + ;; testcover: ok. "Find a section title line around point and return its characteristics. If the point is on an adornment line find the respective title line. If the point is on an empty line check previous or next @@ -1785,89 +1750,57 @@ point is on a suitable title line use it. Return a `rst-Ttl' for a section header or nil if no title line is found." (save-excursion - (1value ;; No lines may be left to move. - (forward-line 0)) - (let ((orig-pnt (point)) - (orig-end (line-end-position))) - (cond - ((looking-at (rst-re 'ado-beg-2-1)) - ;; Adornment found - consider it. - (let ((char (string-to-char (match-string-no-properties 2))) - (r (rst-classify-adornment (match-string-no-properties 0) - (match-end 0)))) - (cond - ((not r) - ;; Invalid adornment - check whether this is an overline with - ;; missing underline. - (if (and - (zerop (forward-line 1)) - (looking-at (rst-re 'ttl-beg-1))) - (rst-Ttl-new (rst-Ado-new-over-and-under char) - (list orig-pnt (line-end-position) - orig-pnt orig-end - (point) (line-end-position) - nil nil) - (current-indentation) - (match-string-no-properties 1)))) - ((rst-Ado-is-transition (rst-Ttl-ado r)) - nil) - ;; Return any other classification as is. - (r)))) - ((looking-at (rst-re 'lin-end)) - ;; Empty line found - check surrounding lines for a title. - (or - (save-excursion - (if (and (zerop (forward-line -1)) - (looking-at (rst-re 'ttl-beg-1))) - (rst-Ttl-new nil - (list (point) (line-end-position) - nil nil - (point) (line-end-position) - nil nil) - (current-indentation) - (match-string-no-properties 1)))) - (save-excursion - (if (and (zerop (forward-line 1)) - (looking-at (rst-re 'ttl-beg-1))) - (rst-Ttl-new nil - (list (point) (line-end-position) - nil nil - (point) (line-end-position) - nil nil) - (current-indentation) - (match-string-no-properties 1)))))) - ((looking-at (rst-re 'ttl-beg-1)) - ;; Title line found - check for a following underline. - (let ((txt (match-string-no-propertie... [truncated message content] |
From: <sm...@us...> - 2017-01-08 09:54:37
|
Revision: 8015 http://sourceforge.net/p/docutils/code/8015 Author: smerten Date: 2017-01-08 09:54:35 +0000 (Sun, 08 Jan 2017) Log Message: ----------- Debug: `rst-forward-indented-block` starts at searching at next line again. Fixes fontification of comments continuing on the same line they started. Modified Paths: -------------- trunk/docutils/tools/editors/emacs/rst.el trunk/docutils/tools/editors/emacs/tests/font-lock.el Modified: trunk/docutils/tools/editors/emacs/rst.el =================================================================== --- trunk/docutils/tools/editors/emacs/rst.el 2017-01-05 09:49:26 UTC (rev 8014) +++ trunk/docutils/tools/editors/emacs/rst.el 2017-01-08 09:54:35 UTC (rev 8015) @@ -244,7 +244,7 @@ ;; 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.1058.2.2 2017/01/03 21:56:09 stefan Exp $") + "$CVSHeader: sm/rst_el/rst.el,v 1.1058.2.8 2017/01/08 09:54:27 stefan Exp $") (defconst rst-cvs-rev (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" " .*" rst-cvs-header "0.0") @@ -269,7 +269,7 @@ ;; Maintained by the release process. (defconst rst-official-version (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " - "%OfficialVersion: 1.5.1 %") + "%OfficialVersion: 1.5.2 %") "Official version of the package.") (defconst rst-official-cvs-rev (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " @@ -297,6 +297,8 @@ ("1.4.2" . "24.5") ("1.5.0" . "26.1") ("1.5.1" . "26.2") + ("1.5.2" . "26.2") + ;; Whatever the Emacs version is this rst.el version ends up in. )) (unless (assoc rst-official-version rst-package-emacs-version-alist) @@ -4148,25 +4150,26 @@ (defun rst-forward-indented-block (&optional column limit) ;; testcover: ok. "Move forward across one indented block. -Find the next non-empty line which is not indented at least to -COLUMN (defaults to the column of the point). Moves point to -first character of this line or the first of the empty lines -immediately before it and returns that position. If there is no -such line before LIMIT (defaults to the end of the buffer) -returns nil and point is not moved." +Find the next (i.e. excluding the current line) non-empty line +which is not indented at least to COLUMN (defaults to the column +of the point). Move point to first character of this line or the +first of the empty lines immediately before it and return that +position. If there is no such line before LIMIT (defaults to the +end of the buffer) return nil and do not move point." (let (fnd candidate) (setq fnd (rst-apply-indented-blocks - (point) (or limit (point-max)) (or column (current-column)) - #'(lambda (_count _in-first _in-sub in-super in-empty _relind) - (cond - (in-empty - (setq candidate (or candidate (line-beginning-position))) - nil) - (in-super - (or candidate (line-beginning-position))) - (t ; Non-empty, same or more indented line. - (setq candidate nil) - nil))))) + (line-beginning-position 2) ; Skip the current line + (or limit (point-max)) (or column (current-column)) + #'(lambda (_count _in-first _in-sub in-super in-empty _relind) + (cond + (in-empty + (setq candidate (or candidate (line-beginning-position))) + nil) + (in-super + (or candidate (line-beginning-position))) + (t ; Non-empty, same or more indented line. + (setq candidate nil) + nil))))) (when fnd (goto-char fnd)))) Modified: trunk/docutils/tools/editors/emacs/tests/font-lock.el =================================================================== --- trunk/docutils/tools/editors/emacs/tests/font-lock.el 2017-01-05 09:49:26 UTC (rev 8014) +++ trunk/docutils/tools/editors/emacs/tests/font-lock.el 2017-01-08 09:54:35 UTC (rev 8015) @@ -107,6 +107,39 @@ ") t nil)) + (should (ert-equal-buffer-return + '(rst-forward-indented-block) + (concat "abc\^@ def +ghi +") + (concat "abc def +\^@ghi +") + 9)) + (should (ert-equal-buffer-return + '(rst-forward-indented-block) + (concat "abc\^@ def +ghi") + (concat "abc def +\^@ghi") + 9)) + (should (ert-equal-buffer-return + '(rst-forward-indented-block) + (concat ".. \^@abc + def + + ghi + +jkl +") + (concat ".. abc + def + + ghi +\^@ +jkl +") + 23)) ) (defun extend-region (beg end) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <mi...@us...> - 2020-02-06 12:46:55
|
Revision: 8483 http://sourceforge.net/p/docutils/code/8483 Author: milde Date: 2020-02-06 12:46:53 +0000 (Thu, 06 Feb 2020) Log Message: ----------- Use default encoding (utf8) for documentation in tools/editors/emacs. Modified Paths: -------------- trunk/docutils/tools/editors/emacs/IDEAS.rst Removed Paths: ------------- trunk/docutils/tools/editors/emacs/docutils.conf Modified: trunk/docutils/tools/editors/emacs/IDEAS.rst =================================================================== --- trunk/docutils/tools/editors/emacs/IDEAS.rst 2020-02-06 12:46:45 UTC (rev 8482) +++ trunk/docutils/tools/editors/emacs/IDEAS.rst 2020-02-06 12:46:53 UTC (rev 8483) @@ -6,7 +6,7 @@ * Convert the region to an HTML id - * For instance "Eine \xDCberschrift" to "eine-berschrift" + * For instance "Eine Überschrift" to "eine-uberschrift" * According the same rules as reST does this @@ -138,11 +138,11 @@ * Like XML, Lisp - * C-M-u f\xFCr Up + * C-M-u für Up - * C-M-d f\xFCr Down + * C-M-d für Down - * C-M-f / C-M-b f\xFCr Forward / Backward + * C-M-f / C-M-b für Forward / Backward Display of current location =========================== @@ -200,10 +200,10 @@ * Key bindings need to be reused - * However, care must be taken if a file uses `allout-mode` for - instance by comment strings + * However, care must be taken if a file uses `allout-mode` for + instance by comment strings - * In this case key bindings must not be overridden + * In this case key bindings must not be overridden * A command adding / updating `allout-mode` tags could be a solution @@ -267,7 +267,7 @@ * bla - @ + @ * <backtab> should be used to indent in the other direction @@ -280,21 +280,21 @@ * <tab> over list works:: - Text + Text - * GGGGGG - * SSSSSSSSSSSSSSS - * TTTTTTTT - * ZZZZZZZZ + * GGGGGG + * SSSSSSSSSSSSSSS + * TTTTTTTT + * ZZZZZZZZ * <tab> over list doesn't work:: - Text + Text - * GGGGGG - * SSSSSSSSSSSSSSS - * TTTTTTTT - * ZZZZZZZZ + * GGGGGG + * SSSSSSSSSSSSSSS + * TTTTTTTT + * ZZZZZZZZ * An indenting tab on the head of a list item should indent the whole list item instead of only the first line @@ -654,7 +654,7 @@ not be modified * See `Emacs Lisp => 32.19 Text Properties => Special - Properties` + Properties` * It would be nice to also have a visible indication for being automatic insertion Deleted: trunk/docutils/tools/editors/emacs/docutils.conf =================================================================== --- trunk/docutils/tools/editors/emacs/docutils.conf 2020-02-06 12:46:45 UTC (rev 8482) +++ trunk/docutils/tools/editors/emacs/docutils.conf 2020-02-06 12:46:53 UTC (rev 8483) @@ -1,2 +0,0 @@ -[general] -input_encoding: latin-1 This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |