From ca46b2bcb06ade90288fb492ccfb30b294d3565b Mon Sep 17 00:00:00 2001 From: 8HNHoFtE <8HNHoFtE@ares.local> Date: Wed, 1 May 2019 19:03:10 +0200 Subject: [PATCH] Add rst support --- bundle/rst.el | 4619 +++++++++++++++++++++++++++++++++++++++++++++++++ init.el | 8 +- 2 files changed, 4626 insertions(+), 1 deletion(-) create mode 100644 bundle/rst.el diff --git a/bundle/rst.el b/bundle/rst.el new file mode 100644 index 00000000..358d13a4 --- /dev/null +++ b/bundle/rst.el @@ -0,0 +1,4619 @@ +;;; rst.el --- Mode for viewing and editing reStructuredText-documents -*- lexical-binding: t -*- + +;; Copyright (C) 2003-2017 Free Software Foundation, Inc. + +;; Maintainer: Stefan Merten +;; Author: Stefan Merten , +;; Martin Blais , +;; David Goodger , +;; Wei-Wei Guo + +;; 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 . + +;;; 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: +;; +;; - Functions to automatically adjust and cycle the section underline +;; adornments; +;; - A mode that displays the table of contents and allows you to jump anywhere +;; from it; +;; - Functions to insert and automatically update a TOC in your source +;; document; +;; - Function to insert list, processing item bullets and enumerations +;; automatically; +;; - Font-lock highlighting of most reStructuredText structures; +;; - Indentation and filling according to reStructuredText syntax; +;; - Cursor movement according to reStructuredText syntax; +;; - Some other convenience functions. +;; +;; See the accompanying document in the docutils documentation about +;; the contents of this package and how to use it. +;; +;; For more information about reStructuredText, see +;; http://docutils.sourceforge.net/rst.html +;; +;; 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. +;; +;; 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:: +;; +;; (add-hook 'rst-adjust-hook 'rst-toc-update) +;; +;; Syntax highlighting: font-lock is enabled by default. If you want to turn +;; off syntax highlighting to rst-mode, you can use the following:: +;; +;; (setq font-lock-global-modes '(not rst-mode ...)) +;; + +;;; DOWNLOAD + +;; The latest release of this file lies in the docutils source code repository: +;; http://docutils.svn.sourceforge.net/svnroot/docutils/trunk/docutils/tools/editors/emacs/rst.el + +;;; INSTALLATION + +;; Add the following lines to your init file: +;; +;; (require 'rst) +;; +;; If you are using `.txt' as a standard extension for reST files as +;; http://docutils.sourceforge.net/FAQ.html#what-s-the-standard-filename-extension-for-a-restructuredtext-file +;; suggests you may use one of the `Local Variables in Files' mechanism Emacs +;; provides to set the major mode automatically. For instance you may use:: +;; +;; .. -*- mode: rst -*- +;; +;; in the very first line of your file. The following code is useful if you +;; 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)) +;; + +;;; Code: + +;; FIXME: Check through major mode conventions again. + +;; FIXME: Embed complicated `defconst's in `eval-when-compile'. + +;; Common Lisp stuff +(require 'cl-lib) + +;; Correct wrong declaration. +(def-edebug-spec push + (&or [form symbolp] [form gv-place])) + +;; 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' + +(when (and (boundp 'testcover-1value-functions) + (boundp 'testcover-compose-functions)) + ;; Below `lambda' is used in a loop with varying parameters and is thus not + ;; 1valued. + (setq testcover-1value-functions + (delq 'lambda testcover-1value-functions)) + (add-to-list 'testcover-compose-functions 'lambda)) + +(defun rst-testcover-defcustom () + "Remove all customized variables from `testcover-module-constants'. +This seems to be a bug in `testcover': `defcustom' variables are +considered constants. Revert it with this function after each `defcustom'." + (when (boundp 'testcover-module-constants) + (setq testcover-module-constants + (delq nil + (mapcar + #'(lambda (sym) + (if (not (plist-member (symbol-plist sym) 'standard-value)) + sym)) + testcover-module-constants))))) + +(defun rst-testcover-add-compose (fun) + "Add FUN to `testcover-compose-functions'." + (when (boundp 'testcover-compose-functions) + (add-to-list 'testcover-compose-functions fun))) + +(defun rst-testcover-add-1value (fun) + "Add FUN to `testcover-1value-functions'." + (when (boundp 'testcover-1value-functions) + (add-to-list 'testcover-1value-functions fun))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helpers. + +(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)))) + +(defun rst-forward-line-strict (n &optional limit) + ;; testcover: ok. + "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-forward-line-looking-at (n rst-re-args &optional fun) + ;; testcover: ok. + "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))))))) + +(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)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Versions + +(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." + (if (string-match + (concat delim-re head-re "\\(" re "\\)" tail-re delim-re) + var) + (match-string 1 var) + default)) + +;; 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.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") + "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 time stamp of this file.") + +;; Use LastChanged... to really get information from SVN. +(defconst rst-svn-rev + (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " " + "$LastChangedRevision: 8015 $") + "The SVN revision of this file. +SVN revision is the upstream (docutils) revision.") +(defconst rst-svn-timestamp + (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " " + "$LastChangedDate: 2017-01-08 10:54:35 +0100 (So, 08. Jän 2017) $") + "The SVN time stamp of this file.") + +;; Maintained by the release process. +(defconst rst-official-version + (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " + "%OfficialVersion: 1.5.2 %") + "Official version of the package.") +(defconst rst-official-cvs-rev + (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " + "$Revision: 8015 $") + "CVS revision of this file in the official version.") + +(defconst rst-version + (if (equal rst-official-cvs-rev rst-cvs-rev) + rst-official-version + (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 time stamp.") + +(defconst rst-package-emacs-version-alist + '(("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") + ("1.4.1" . "24.5") + ("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) + (error "Version %s not listed in `rst-package-emacs-version-alist'" + rst-version)) + +(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 'text + :version "23.1" + :link '(url-link "http://docutils.sourceforge.net/rst.html")) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Facilities for regular expressions used everywhere + +;; The trailing numbers in the names give the number of referenceable regex +;; groups contained in the regex. + +;; Used to be customizable but really is not customizable but fixed by the reST +;; syntax. +(defconst rst-bullets + ;; Sorted so they can form a character class when concatenated. + '(?- ?* ?+ ?• ?‣ ?⁃) + "List of all possible bullet characters for bulleted lists.") + +(defconst rst-uri-schemes + '("acap" "cid" "data" "dav" "fax" "file" "ftp" "gopher" "http" "https" "imap" + "ldap" "mailto" "mid" "modem" "news" "nfs" "nntp" "pop" "prospero" "rtsp" + "service" "sip" "tel" "telnet" "tip" "urn" "vemmi" "wais") + "Supported URI schemes.") + +(defconst rst-adornment-chars + ;; Sorted so they can form a character class when concatenated. + '(?\] + ?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?+ ?, ?. ?/ ?: ?\; ?< ?= ?> ?? ?@ ?\[ ?\\ + ?^ ?_ ?` ?{ ?| ?} ?~ + ?-) + "Characters which may be used in adornments for sections and transitions.") + +(defconst rst-max-inline-length + 1000 + "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 *. + ;; + ;; 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. + + ;; 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. + + ;; 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. + + ;; Block lead in (`bli') + (bli-sfx (:alt hws-sta "$")) ; Suffix of a block lead-in with *optional* + ; immediate content. + + ;; 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 "\\.\\.") + (exm-sta exm-tag hws-sta) + (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. + + ;; Enumerator (`enm') + (enmany-tag (:alt + (:seq cntany-tag "\\.") + (:seq "(?" cntany-tag ")"))) ; An arbitrary enumerator. + (enmexp-tag (:alt + (:seq cntexp-tag "\\.") + (:seq "(?" cntexp-tag ")"))) ; An arbitrary explicit + ; 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. + (enmexp-beg lin-beg enmexp-sta) ; An arbitrary explicit enumerator start + ; 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-sta-1 (:grp itmany-tag) bli-sfx) ; An arbitrary item start, group + ; 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. + + ;; Inline markup (`ilm') + (ilm-pfx (:alt "^" hws-prt "[-'\"([{<‘“«’/:]")) + (ilm-sfx (:alt "$" hws-prt "[]-'\")}>’”»/:.,;!?\\]")) + + ;; 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. + (ilcbkqdef-prt (:alt "[^`\\\n]" "\\\\.")) ; Part of non-backquote + ; 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. + (ilcast-tag (:alt ilcsgl-tag + (:seq ilcsgl-tag + ilcast-prt ilcrep-hlp + ilcast-sfx))) ; Non-asterisk content. + (ilcbkq-tag (:alt ilcsgl-tag + (:seq ilcsgl-tag + ilcbkq-prt ilcrep-hlp + ilcbkq-sfx))) ; Non-backquote content. + (ilcbkqdef-tag (:alt ilcsgl-tag + (:seq ilcsgl-tag + ilcbkqdef-prt ilcrep-hlp + ilcbkq-sfx))) ; Non-backquote definition. + (ilcbar-tag (:alt ilcsgl-tag + (:seq ilcsgl-tag + ilcbar-prt ilcrep-hlp + ilcbar-sfx))) ; Non-vertical-bar content. + (ilcbardef-tag (:alt ilcsgl-tag + (:seq ilcsgl-tag + ilcbardef-prt ilcrep-hlp + 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. + + ;; 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. + + ;; 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. + (fncdef-tag-2 (:grp exm-sta) + (:grp fnc-tag)) ; A complete footnote or citation definition + ; tag. First group is the explicit markup + ; start, second group is the footnote / + ; citation tag. + (fnc-sta-2 fncdef-tag-2 bli-sfx) ; Start of a footnote or citation + ; definition. First group is the explicit + ; markup start, second group is the + ; footnote / citation tag. + + ;; Substitutions (`sub') + (sub-tag "|" ilcbar-tag "|") ; A complete substitution tag. + (subdef-tag "|" ilcbardef-tag "|") ; A complete substitution definition + ; tag. + + ;; Symbol (`sym') + (sym-prt "[-+.:_]") ; Non-word part of a symbol. + (sym-tag (:shy "\\sw+" (:shy sym-prt "\\sw+") "*")) + + ;; URIs (`uri') + (uri-tag (:alt ,@rst-uri-schemes)) + + ;; Adornment (`ado') + (ado-prt "[" ,(concat rst-adornment-chars) "]") + (adorep3-hlp "\\{3,\\}") ; There must be at least 3 characters because + ; otherwise explicit markup start would be + ; recognized. + (adorep2-hlp "\\{2,\\}") ; As `adorep3-hlp' but when the first of three + ; 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. + (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. + (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. + + ;; Titles (`ttl') + (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) + (:grp (:shy subdef-tag hws-sta) "?") + (:grp sym-tag dcl-tag)) ; A directive or substitution definition + ; 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. + (dir-sta-3 dir-tag-3 bli-sfx) ; Start of a directive or substitution + ; 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 + ; any text before the double colon tag which + ; may not exist, second group is the double + ; 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. + + ;; 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. + ) + "Definition alist of relevant regexes. +Each entry consists of the symbol naming the regex and an +argument list for `rst-re'.") + +(defvar rst-re-alist) ; Forward declare to use it in `rst-re'. + +;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel. +(rst-testcover-add-compose 'rst-re) +(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: + +A string which is inserted unchanged. + +A character which is resolved to a quoted regex. + +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 +interpretation are concatenated according to the keyword. + +For the keyword `:seq' the results are simply concatenated. + +For the keyword `:shy' the results are concatenated and +surrounded by a shy-group (\"\\(?:...\\)\"). + +For the keyword `:alt' the results form an alternative (\"\\|\") +which is shy-grouped (\"\\(?:...\\)\"). + +For the keyword `:grp' the results are concatenated and form a +referenceable group (\"\\(...\\)\"). + +After interpretation of ARGS the results are concatenated as for +`:seq'." + (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)))) + args))) + +;; 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.")) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 + +(cl-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." + (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." + (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." + (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." + (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." + (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 (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 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 + +(cl-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 nil)) ; 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." + (cl-check-type indent integer) + (cond + ((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")))) + ;; 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 + ((rst-Ado-is-transition ado) + (signal 'args-out-of-range + '("Adornment for header must not be transition."))) + (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 (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 + +(defun rst-Hdr-member-ado (self hdrs) + ;; testcover: ok. + "Return sublist of HDRS whose car's adornment equals that of SELF or nil." + (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 (selves) + ;; testcover: ok. + "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." + (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." + (cl-check-type self rst-Hdr) + (rst-Ado-is-over-and-under (rst-Hdr-ado self))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Class rst-Ttl + +(cl-defstruct + (rst-Ttl + (:constructor nil) ; Prevent creating unchecked values. + ;; Construct with valid parameters for all attributes. + (:constructor ; Private constructor + rst-Ttl--new + (ado-arg + match-arg + indent-arg + text-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 (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' 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 :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." + (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." + (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 + '("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)) + (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-text (text ado) + ;; testcover: ok. + "Return valid TEXT for ADO or signal error." + (if (and ado (rst-Ado-is-transition ado)) + (cl-check-type text null + "Transitions may not have title text.") + (cl-check-type text string)) + text) + +;; Public class methods + +(defun rst-Ttl-from-buffer (ado beg-ovr beg-txt beg-und txt) + ;; testcover: ok. + "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-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 + +(cl-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)) +;; 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." + (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." + (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." + (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."))) + children) + +;; Public methods + +(defun rst-Stn-get-title-beginning (self) + ;; testcover: ok. + "Return the beginning of the title of SELF. +Handles missing node properly." + (cl-check-type self rst-Stn) + (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." + (cl-check-type self rst-Stn) + (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." + (cl-check-type self rst-Stn) + (< (rst-Stn-level self) 0)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Mode definition + +(defun rst-define-key (keymap key def &rest deprecated) + ;; testcover: ok. + "Bind like `define-key' but add deprecated key definitions. +KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key +definitions should be in vector notation. These are defined +as well but give an additional message." + (define-key keymap key def) + (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 + (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) + (define-key keymap dep-key forwarder-function))))) + + ;; Key bindings. +(defvar rst-mode-map + (let ((map (make-sparse-keymap))) + + ;; \C-c is the general keymap. + (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 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) + ;; 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-hdr-hierarchy) + ;; Homogenize the adornments in the document. + (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 + ;; 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 + ;; Same as beginning-of-defun. + [?\C-c ?\C-n]) + (rst-define-key map [?\C-\M-e] #'rst-forward-section + ;; Same as end-of-defun. + [?\C-c ?\C-p]) + + ;; + ;; 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) + ;; 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. + (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) + ;; Makes paragraphs in region as a bullet list. + (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 + [?\C-c ?\C-e]) + ;; Converts bullets to an 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 + [?\C-c ?\C-w]) + ;; Insert a list item. + (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) + ;; Enter a TOC buffer to view and move to a specific section. + (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 + [?\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 + [?\C-c ?\C-u]) + ;; 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) + ;; Run one of two pre-configured toolset commands on the document. + (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 + [?\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 + [?\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 + [?\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 + [?\C-c ?5]) + + map) + "Keymap for reStructuredText mode commands. +This inherits from Text mode.") + + +;; Abbrevs. +(define-abbrev-table 'rst-mode-abbrev-table + (mapcar #'(lambda (x) + (append x '(nil 0 system))) + '(("contents" ".. contents::\n..\n ") + ("con" ".. contents::\n..\n ") + ("cont" "[...]") + ("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 ?“ "." 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." + :group 'rst + :type '(hook)) +(rst-testcover-defcustom) + +;; Pull in variable definitions silencing byte-compiler. +(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. +;;;###autoload (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) +;;;###autoload +(define-derived-mode rst-mode text-mode "ReST" + "Major mode for editing reStructuredText documents. +\\ + +Turning on `rst-mode' calls the normal hooks `text-mode-hook' +and `rst-mode-hook'. This mode also supports font-lock +highlighting. + +\\{rst-mode-map}" + :abbrev-table rst-mode-abbrev-table + :syntax-table rst-mode-syntax-table + :group 'rst + + ;; Paragraph recognition. + (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. + (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. + (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. + (setq-local comment-end "") + (setq-local comment-end-skip nil) + + ;; 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 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) + + ;; Font lock. + (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. + (setq-local jit-lock-contextually t) + + ;; Indentation is not deterministic. + (setq-local electric-indent-inhibit t)) + +;;;###autoload +(define-minor-mode rst-minor-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 +for modes derived from Text mode, like Mail mode." + ;; The initial value. + nil + ;; The indicator for the mode line. + " ReST" + ;; The minor mode bindings. + rst-mode-map + :group 'rst) + +;; FIXME: can I somehow install these too? +;; :abbrev-table rst-mode-abbrev-table +;; :syntax-table rst-mode-syntax-table + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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. +;; +;; Some notes: +;; +;; - The underlining character that is used depends on context. The file is +;; scanned to find other sections and an appropriate character is selected. +;; If the function is invoked on a section that is complete, the character is +;; 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 +;; 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 +;; the file. +;; +;; - An underline/overline that is not extended to the column at which it should +;; be hanging is dubbed INCOMPLETE. For example:: +;; +;; |Some Title +;; |------- +;; +;; Examples of default invocation: +;; +;; |Some Title ---> |Some Title +;; | |---------- +;; +;; |Some Title ---> |Some Title +;; |----- |---------- +;; +;; | |------------ +;; | Some Title ---> | Some Title +;; | |------------ +;; +;; In over-and-under style, when alternating the style, a variable is +;; available to select how much default indent to use (it can be zero). Note +;; that if the current section adornment already has an indent, we don't +;; adjust it to the default, we rather use the current indent that is already +;; there for adjustment (unless we cycle, in which case we use the indent +;; that has been found previously). + +(defgroup rst-adjust nil + "Settings for adjustment and cycling of section title adornments." + :group 'rst + :version "21.1") + +(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) + (?~ simple 0) + (?+ simple 0) + (?` simple 0) + (?# 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'. + +This sequence is consulted to offer a new adornment suggestion +when we rotate the underlines at the end of the existing +hierarchy of characters, or when there is no existing section +title in the file. + +Set this to an empty list to use only the adornment found in the +file." + :group 'rst-adjust + :type `(repeat + (group :tag "Adornment specification" + (choice :tag "Adornment character" + ,@(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) + (const :tag "Underline only" simple)) + (integer :tag "Indentation for overline and underline type" + :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 only used while toggling adornment styles when switching +from a simple adornment style to a over-and-under adornment +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-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)))) + (cl-find-if #'(lambda (cand) + (not (rst-Hdr-member-ado cand seen))) + candidates))) + +(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 +requested adornment." + (end-of-line) + (let ((indent (or (rst-Hdr-indent hdr) 0)) + (marker (point-marker)) + new) + + ;; Fixup whitespace at the beginning and end of the 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))) + + ;; Remove previous line if it is an adornment. + ;; 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. + (not (rst-forward-line-looking-at -2 'ttl-beg-1))) + (rst-delete-entire-line -1)) + + ;; Remove following line if it is an adornment. + (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) + (1value ; Underline inserted above. + (rst-forward-line-strict -1)) + (open-line 1) + (insert new)) + + (goto-char marker))) + +(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. 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)) ; RE matching the + ; adornment. + (beg-pnt (progn + (1value + (rst-forward-line-strict 0)) + (point))) + (nxt-emp ; Next line nonexistent or empty + (not (rst-forward-line-looking-at +1 'lin-end #'not))) + (prv-emp ; Previous line nonexistent or empty + (not (rst-forward-line-looking-at -1 'lin-end #'not))) + txt-blw + (ttl-blw ; Title found below starting here. + (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. + (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. + (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. + (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. + (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. + (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. + (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. + 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 +line whether it is a suitable title line and use it if so. If +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 + (save-match-data + (1value + (rst-forward-line-strict 0)) + (let* (cnd-beg ; Beginning of a title candidate. + cnd-txt ; Text of a title candidate. + (cnd-fun #'(lambda (mtcd) ; Function setting title candidate data. + (when mtcd + (setq cnd-beg (match-beginning 0)) + (setq cnd-txt (match-string-no-properties 1)) + t))) + ttl) + (cond + ((looking-at (rst-re 'ado-beg-2-1)) + ;; Adornment found - consider it. + (setq ttl (rst-classify-adornment (match-string-no-properties 0) + (match-end 0) t))) + ((looking-at (rst-re 'lin-end)) + ;; Empty line found - check surrounding lines for a title. + (or + (rst-forward-line-looking-at -1 'ttl-beg-1 cnd-fun) + (rst-forward-line-looking-at +1 'ttl-beg-1 cnd-fun))) + ((looking-at (rst-re 'ttl-beg-1)) + ;; Title line found - check for a following underline. + (setq ttl (rst-forward-line-looking-at + 1 'ado-beg-2-1 + #'(lambda (mtcd) + (when mtcd + (rst-classify-adornment + (match-string-no-properties 0) (match-end 0)))))) + ;; Title candidate found if no valid adornment found. + (funcall cnd-fun (not ttl)))) + (cond + ((and ttl (rst-Ttl-is-section ttl)) + ttl) + (cnd-beg + (rst-Ttl-from-buffer nil nil cnd-beg nil cnd-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-local 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.") + +;; FIXME: If this variable is set to a different value font-locking of section +;; headers is wrong. +(defvar-local 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-ttls-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-ttls-cache nil + rst-hdr-hierarchy-cache nil)) + +(defun rst-all-ttls-compute () + ;; testcover: ok. + "Return a list of `rst-Ttl' for current buffer with ascending line number." + (save-excursion + (save-match-data + (let (ttls) + (goto-char (point-min)) + ;; Iterate over all the section titles/adornments in the file. + (while (re-search-forward (rst-re 'ado-beg-2-1) nil t) + (let ((ttl (rst-classify-adornment + (match-string-no-properties 0) (point)))) + (when (and ttl (rst-Ttl-is-section ttl)) + (when (rst-Ttl-hdr ttl) + (push ttl ttls)) + (goto-char (rst-Ttl-get-end ttl))))) + (nreverse ttls))))) + +(defun rst-all-ttls () + "Return all the section adornments in the current buffer. +Return a list of `rst-Ttl' with ascending line number. + +Uses and sets `rst-all-ttls-cache'." + (unless rst-all-ttls-cache + (setq rst-all-ttls-cache (or (rst-all-ttls-compute) t))) + (if (eq rst-all-ttls-cache t) + nil + (copy-sequence rst-all-ttls-cache))) + +(defun rst-infer-hdr-hierarchy (hdrs) + ;; testcover: ok. + "Build a hierarchy from HDRS. +HDRS reflects the order in which the headers appear in the +buffer. Return a `rst-Hdr' list representing the hierarchy of +headers in the buffer. Indentation is unified." + (let (ado2indents) ; Asscociates `rst-Ado' with the set of indents seen for + ; it. + (dolist (hdr hdrs) + (let* ((ado (rst-Hdr-ado hdr)) + (indent (rst-Hdr-indent hdr)) + (found (assoc ado ado2indents))) + (if found + (setcdr found (cl-adjoin indent (cdr found))) + (push (list ado indent) ado2indents)))) + (mapcar (cl-function + (lambda ((ado consistent &rest inconsistent)) + (rst-Hdr-new ado (if inconsistent + rst-default-indent + consistent)))) + (nreverse ado2indents)))) + +(defun rst-hdr-hierarchy (&optional ignore-position) + ;; testcover: ok. + "Return the hierarchy of section titles in the file as a `rst-Hdr' list. +Each returned element may be used directly to create a section +adornment on that level. If IGNORE-POSITION a title containing +this position is not taken into account when building the +hierarchy unless it appears again elsewhere. This catches cases +where the current title is edited and may not be final regarding +its level. + +Uses and sets `rst-hdr-hierarchy-cache' unless IGNORE-POSITION is +given." + (let* ((all-ttls (rst-all-ttls)) + (ignore-ttl + (if ignore-position + (cl-find-if + #'(lambda (ttl) + (equal (rst-Ttl-contains ttl ignore-position) 0)) + all-ttls))) + (really-ignore + (if ignore-ttl + (<= (cl-count-if + #'(lambda (ttl) + (rst-Ado-equal (rst-Ttl-ado ignore-ttl) + (rst-Ttl-ado ttl))) + all-ttls) + 1))) + (real-ttls (delq (if really-ignore ignore-ttl) all-ttls))) + (copy-sequence ; Protect cache. + (if (and (not ignore-position) rst-hdr-hierarchy-cache) + (if (eq rst-hdr-hierarchy-cache t) + nil + rst-hdr-hierarchy-cache) + (let ((r (rst-infer-hdr-hierarchy (mapcar #'rst-Ttl-hdr real-ttls)))) + (setq rst-hdr-hierarchy-cache + (if ignore-position + ;; Clear cache reflecting that a possible update is not + ;; reflected. + nil + (or r t))) + r))))) + +(defun rst-all-ttls-with-level () + ;; testcover: ok. + "Return the section adornments with levels set according to hierarchy. +Return a list of (`rst-Ttl' . LEVEL) with ascending line number." + (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) + (mapcar + #'(lambda (ttl) + (cons ttl (rst-Ado-position (rst-Ttl-ado ttl) hier))) + (rst-all-ttls)))) + +(defun rst-get-previous-hdr () + "Return the `rst-Hdr' before point or nil if none." + (let ((prev (cl-find-if #'(lambda (ttl) + (< (rst-Ttl-contains ttl (point)) 0)) + (rst-all-ttls) + :from-end t))) + (and prev (rst-Ttl-hdr prev)))) + +(defun rst-adornment-complete-p (ado indent) + ;; testcover: ok. + "Return t if the adornment ADO around point is complete using INDENT. +The adornment is complete if it is a completely correct +reStructuredText adornment for the title line at point. This +includes indentation and correct length of adornment lines." + ;; Note: we assume that the detection of the overline as being the underline + ;; of a preceding title has already been detected, and has been eliminated + ;; from the adornment that is given to us. + (let ((exps (list "^" (rst-Ado-char ado) + (format "\\{%d\\}" + (+ (save-excursion + ;; Determine last column of title. + (end-of-line) + (current-column)) + indent)) "$"))) + (and (rst-forward-line-looking-at +1 exps) + (or (rst-Ado-is-simple ado) + (rst-forward-line-looking-at -1 exps)) + t))) ; Normalize return value. + +(defun rst-next-hdr (hdr hier prev down) + ;; testcover: ok. + "Return the next best `rst-Hdr' upward from HDR. +Consider existing hierarchy HIER and preferred headers. PREV may +be a previous `rst-Hdr' which may be taken into account. If DOWN +return the next best `rst-Hdr' downward instead. Return nil in +HIER is nil." + (let* ((normalized-hier (if down + hier + (reverse hier))) + (fnd (rst-Hdr-member-ado hdr normalized-hier)) + (prev-fnd (and prev (rst-Hdr-member-ado prev normalized-hier)))) + (or + ;; Next entry in existing hierarchy if it exists. + (cadr fnd) + (if fnd + ;; If current header is found try introducing a new one from preferred + ;; hierarchy. + (rst-new-preferred-hdr hier prev) + ;; If not found try using previous header. + (if down + (cadr prev-fnd) + (car prev-fnd))) + ;; All failed - rotate by using first from normalized existing hierarchy. + (car normalized-hier)))) + +;; FIXME: A line "``/`` full" is not accepted as a section title. +(defun rst-adjust (pfxarg) + ;; testcover: ok. + "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, +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. + +See the documentations of `rst-adjust-section' and +`rst-adjust-region' for full details. + +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 argument for example; + +b. a negative numerical argument, which generally inverts the + direction of search in the file or hierarchy. Invoke with C-- + prefix for example." + (interactive "P") + (let* ((origpt (point-marker)) + (reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0))) + (toggle-style (and pfxarg (not reverse-direction)))) + (if (use-region-p) + (rst-adjust-region (and pfxarg t)) + (let ((msg (rst-adjust-section toggle-style reverse-direction))) + (when msg + (apply #'message msg)))) + (run-hooks 'rst-adjust-hook) + (rst-reset-section-caches) + (set-marker + (goto-char origpt) nil))) + +(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." + :group 'rst-adjust + :type '(choice + (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-section' interactively. +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))) + (toggle-style (and pfxarg (not reverse-direction)))) + (rst-adjust-section toggle-style reverse-direction))) + +(defun rst-adjust-new-hdr (toggle-style reverse ttl) + ;; testcover: ok. + "Return a new `rst-Hdr' for `rst-adjust-section' related to TTL. +TOGGLE-STYLE and REVERSE are from +`rst-adjust-section'. TOGGLE-STYLE may be consumed and thus is +returned. + +Return a list (HDR TOGGLE-STYLE MSG...). HDR is the result or +nil. TOGGLE-STYLE is the new TOGGLE-STYLE to use in the +caller. MSG is a list which is non-empty in case HDR is nil +giving an argument list for `message'." + (save-excursion + (goto-char (rst-Ttl-get-title-beginning ttl)) + (let ((indent (rst-Ttl-indent ttl)) + (ado (rst-Ttl-ado ttl)) + (prev (rst-get-previous-hdr)) + hdr-msg) + (setq + hdr-msg + (cond + ((rst-Ttl-is-candidate ttl) + ;; Case 1: No adornment at all. + (let ((hier (rst-hdr-hierarchy))) + (if prev + ;; Previous header exists - use it. + (cond + ;; Customization and parameters require that the previous level + ;; is used - use it as is. + ((or (and rst-new-adornment-down reverse) + (and (not rst-new-adornment-down) (not reverse))) + prev) + ;; Advance one level down. + ((rst-next-hdr prev hier prev t)) + ("Neither hierarchy nor preferences can suggest a deeper header")) + ;; First header in the buffer - use the first adornment from + ;; preferences or hierarchy. + (let ((p (car (rst-Hdr-preferred-adornments))) + (h (car hier))) + (cond + ((if reverse + ;; Prefer hierarchy for downwards + (or h p) + ;; Prefer preferences for upwards + (or p h))) + ("No preferences to suggest a top level from")))))) + ((not (rst-adornment-complete-p ado indent)) + ;; Case 2: Incomplete adornment. + ;; Use lax since indentation might not match suggestion. + (rst-Hdr-new-lax ado indent)) + ;; Case 3: Complete adornment exists from here on. + (toggle-style + ;; Simply switch the style of the current adornment. + (setq toggle-style nil) ; Remember toggling has been done. + (rst-Hdr-new-invert ado rst-default-indent)) + (t + ;; Rotate, ignoring a sole adornment around the current line. + (let ((hier (rst-hdr-hierarchy (point)))) + (cond + ;; Next header can be determined from hierarchy or preferences. + ((rst-next-hdr + ;; Use lax since indentation might not match suggestion. + (rst-Hdr-new-lax ado indent) hier prev reverse)) + ;; No next header found. + ("No preferences or hierarchy to suggest another level from")))))) + (if (stringp hdr-msg) + (list nil toggle-style hdr-msg) + (list hdr-msg toggle-style))))) + +(defun rst-adjust-section (toggle-style reverse) + ;; testcover: ok. + "Adjust/rotate the section adornment for the section title around point. +The action this function takes depends on context around the +point, and it is meant to be invoked possibly more than once to +rotate among the various possibilities. Basically, this function +deals with: + +- adding an adornment if the title does not have one; + +- adjusting the length of the underline characters to fit a + modified title; + +- rotating the adornment in the set of already existing + sectioning adornments used in the file; + +- switching between simple and over-and-under styles by giving + TOGGLE-STYLE. + +Return nil if the function did something. If the function were +not able to do something return an argument list for `message' to +inform the user about what failed. + +The following is a detailed description but you should normally +not have to read it. + +Before applying the adornment change, the cursor is placed on the +closest line that could contain a section title if such is found +around the cursor. Then the following cases are distinguished. + +* Case 1: No Adornment + + If the current line has no adornment around it, + + - search for a previous adornment, and apply this adornment (unless + `rst-new-adornment-down') or one level lower (otherwise) to the current + line. If there is no defined level below this previous adornment, we + suggest the most appropriate of the `rst-preferred-adornments'. + + If REVERSE is true, we simply use the previous adornment found + directly. + + - if there is no adornment found in the given direction, we use the first of + `rst-preferred-adornments'. + + TOGGLE-STYLE forces a toggle of the prescribed adornment style. + +* Case 2: Incomplete Adornment + + 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 underlines/overlines to fit exactly the section title. + + If TOGGLE-STYLE we toggle the style of the adornment as well. + + REVERSE has no effect in this case. + +* Case 3: Complete Existing Adornment + + If the adornment is complete (i.e. the underline (overline) length is already + adjusted to the end of the title line), we rotate the current title's + adornment according to the adornment hierarchy found in the buffer. This is + meant to be used potentially multiple times, until the desired adornment is + found around the title. + + If we hit the boundary of the hierarchy, exactly one choice from the list of + preferred adornments is suggested/chosen, the first of those adornment that + has not been seen in the buffer yet, and the next invocation rolls over to + the other end of the hierarchy (i.e. it cycles). + + If REVERSE is we go up in the hierarchy. Otherwise we go down. + + However, if TOGGLE-STYLE, we do not rotate the adornment, but instead simply + toggle the style of the current adornment." + (rst-reset-section-caches) + (let ((ttl (rst-ttl-at-point))) + (if (not ttl) + '("No section header or candidate at point") + (cl-destructuring-bind + (hdr toggle-style &rest msg + &aux + (indent (rst-Ttl-indent ttl)) + (moved (- (line-number-at-pos (rst-Ttl-get-title-beginning ttl)) + (line-number-at-pos)))) + (rst-adjust-new-hdr toggle-style reverse ttl) + (if msg + msg + (when toggle-style + (setq hdr (rst-Hdr-new-invert (rst-Hdr-ado hdr) indent))) + ;; Override indent with present indent if there is some. + (when (> indent 0) + ;; Use lax since existing indent may not be valid for new style. + (setq hdr (rst-Hdr-new-lax (rst-Hdr-ado hdr) indent))) + (goto-char (rst-Ttl-get-title-beginning ttl)) + (rst-update-section hdr) + ;; Correct the position of the cursor to more accurately reflect + ;; where it was located when the function was invoked. + (unless (zerop moved) + (1value ; No lines may be left to move. + (rst-forward-line-strict (- moved))) + (end-of-line)) + nil))))) + +;; Maintain an alias for compatibility. +(defalias 'rst-adjust-section-title 'rst-adjust) + +(defun rst-adjust-region (demote) + ;; testcover: ok. + "Promote the section titles within the region. +With argument DEMOTE or a prefix argument, demote the section +titles instead. The algorithm used at the boundaries of the +hierarchy is similar to that used by `rst-adjust-section'." + (interactive "P") + (rst-reset-section-caches) + (let* ((beg (region-beginning)) + (end (region-end)) + (ttls-reg (cl-remove-if-not + #'(lambda (ttl) + (and + (>= (rst-Ttl-contains ttl beg) 0) + (< (rst-Ttl-contains ttl end) 0))) + (rst-all-ttls)))) + (save-excursion + ;; Apply modifications. + (rst-destructuring-dolist + ((marker &rest hdr + &aux (hier (rst-hdr-hierarchy))) + (mapcar #'(lambda (ttl) + (cons (copy-marker (rst-Ttl-get-title-beginning ttl)) + (rst-Ttl-hdr ttl))) + ttls-reg)) + (set-marker + (goto-char marker) nil) + ;; `rst-next-hdr' cannot return nil because we apply to a section + ;; header so there is some hierarchy. + (rst-update-section (rst-next-hdr hdr hier nil demote))) + (setq deactivate-mark nil)))) + +(defun rst-display-hdr-hierarchy () + ;; testcover: ok. + "Display the current file's section title adornments hierarchy. +Hierarchy is displayed in a temporary buffer." + (interactive) + (rst-reset-section-caches) + (let ((hdrs (rst-hdr-hierarchy)) + (level 1)) + (with-output-to-temp-buffer "*rest section hierarchy*" + (with-current-buffer standard-output + (dolist (hdr hdrs) + (insert (format "\nSection Level %d" level)) + (rst-update-section hdr) + (goto-char (point-max)) + (insert "\n") + (cl-incf level)))))) + +;; Maintain an alias for backward compatibility. +(defalias 'rst-display-adornments-hierarchy 'rst-display-hdr-hierarchy) + +;; FIXME: Should accept an argument giving the hierarchy level to start with +;; instead of the top of the hierarchy. +(defun rst-straighten-sections () + ;; testcover: ok. + "Redo the adornments of all section titles in the current buffer. +This is done using the preferred set of adornments. This can be +used, for example, when using somebody else's copy of a document, +in order to adapt it to our preferred style." + (interactive) + (rst-reset-section-caches) + (save-excursion + (rst-destructuring-dolist + ((marker &rest level) + (mapcar + (cl-function + (lambda ((ttl &rest level)) + ;; Use markers so edits don't disturb the position. + (cons (copy-marker (rst-Ttl-get-title-beginning ttl)) level))) + (rst-all-ttls-with-level))) + (set-marker + (goto-char marker) nil) + (rst-update-section (nth level (rst-Hdr-preferred-adornments)))))) + +;; Maintain an alias for compatibility. +(defalias 'rst-straighten-adornments 'rst-straighten-sections) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Insert list items + +;; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell . I +;; needed to make some tiny changes to the functions, so I put it here. +;; -- Wei-Wei Guo + +(defconst rst-arabic-to-roman + '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") + (100 . "C") (90 . "XC") (50 . "L") (40 . "XL") + (10 . "X") (9 . "IX") (5 . "V") (4 . "IV") + (1 . "I")) + "List of maps between Arabic numbers and their Roman numeral equivalents.") + +(defun rst-arabic-to-roman (num) + ;; testcover: ok. + "Convert Arabic number NUM to its Roman numeral representation. + +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)." + (cl-check-type num (integer 1 *)) + (let ((map rst-arabic-to-roman) + (r "")) + (while (and map (> num 0)) + (cl-destructuring-bind ((val &rest sym) &rest next) map + (if (>= num val) + (setq r (concat r sym) + num (- num val)) + (setq map next)))) + r)) + +(defun rst-roman-to-arabic (string) + ;; testcover: ok. + "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. +Hence: +MMD == 2500 +and +MMDFLXXVI == 2500." + (cl-check-type string string) + (cl-check-type string (satisfies (lambda (s) + (not (equal s "")))) + "Roman number may not be an empty string.") + (let ((res 0) + (map rst-arabic-to-roman)) + (save-match-data + (while map + (cl-destructuring-bind ((val &rest sym) &rest next) map + (if (string-match (concat "^" sym) string) + (setq res (+ res val) + string (replace-match "" nil t string)) + (setq map next)))) + (cl-check-type string (satisfies (lambda (s) + (equal s ""))) + "Invalid characters in roman number") + res))) + +;; End of borrow. + +;; FIXME: All the following code should not consider single lines as items but +;; paragraphs as reST does. + +(defun rst-insert-list-new-tag (tag) + ;; testcover: ok. + "Insert first item of a new list tagged with TAG. + +Adding a new list might consider three situations: + + (a) Current line is a blank line. + (b) Previous line is a blank line. + (c) Following line is a blank line. + +When (a) and (b), just add the new list at current line. + +when (a) and not (b), a blank line is added before adding the new list. + +When not (a), first forward point to the end of the line, and add two +blank lines, then add the new list. + +Other situations are just ignored and left to users themselves." + ;; FIXME: Following line is not considered at all. + (let ((pfx-nls + ;; FIXME: Doesn't work properly for white-space line. See + ;; `rst-insert-list-new-BUGS'. + (if (rst-forward-line-looking-at 0 'lin-end) + (if (not (rst-forward-line-looking-at -1 'lin-end #'not)) + 0 + 1) + 2))) + (end-of-line) + ;; FIXME: The indentation is not fixed to a single space by the syntax. May + ;; be this should be configurable or rather taken from the context. + (insert (make-string pfx-nls ?\n) tag " "))) + +(defconst rst-initial-items + (append (mapcar #'char-to-string rst-bullets) + (let (vals) + (dolist (fmt '("%s." "(%s)" "%s)")) + (dolist (c '("#" "1" "a" "A" "I" "i")) + (push (format fmt c) vals))) + (nreverse vals))) + "List of initial items. It's a collection of bullets and enumerations.") + +(defun rst-insert-list-new-item () + ;; testcover: ok. + "Insert a new list item. + +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-new-tag'. + +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-new-tag'." + (let* ((itemstyle (completing-read + "Select preferred item style [#.]: " + rst-initial-items nil t nil nil "#.")) + (cnt (if (string-match (rst-re 'cntexp-tag) itemstyle) + (match-string 0 itemstyle))) + (no + (save-match-data + (cond + ((equal cnt "a") + (let ((itemno (read-string "Give starting value [a]: " + nil nil "a"))) + (downcase (substring itemno 0 1)))) + ((equal cnt "A") + (let ((itemno (read-string "Give starting value [A]: " + nil nil "A"))) + (upcase (substring itemno 0 1)))) + ((equal cnt "I") + (let ((itemno (read-number "Give starting value [1]: " 1))) + (rst-arabic-to-roman itemno))) + ((equal cnt "i") + (let ((itemno (read-number "Give starting value [1]: " 1))) + (downcase (rst-arabic-to-roman itemno)))) + ((equal cnt "1") + (let ((itemno (read-number "Give starting value [1]: " 1))) + (number-to-string itemno))))))) + (if no + (setq itemstyle (replace-match no t t itemstyle))) + (rst-insert-list-new-tag itemstyle))) + +(defcustom rst-preferred-bullets + '(?* ?- ?+) + "List of favorite bullets." + :group 'rst + :type `(repeat + (choice ,@(mapcar #'(lambda (char) + (list 'const + :tag (char-to-string char) char)) + rst-bullets))) + :package-version '(rst . "1.1.0")) +(rst-testcover-defcustom) + +(defun rst-insert-list-continue (ind tag tab prefer-roman) + ;; testcover: ok. + "Insert a new list tag after the current line according to style. +Style is defined by indentaton IND, TAG and suffix TAB. If +PREFER-ROMAN roman numbering is preferred over using letters." + (end-of-line) + (insert + ;; FIXME: Separating lines must be possible. + "\n" + ind + (save-match-data + (if (not (string-match (rst-re 'cntexp-tag) tag)) + tag + (let ((pfx (substring tag 0 (match-beginning 0))) + (cnt (match-string 0 tag)) + (sfx (substring tag (match-end 0)))) + (concat + pfx + (cond + ((string-match (rst-re 'num-tag) cnt) + (number-to-string (1+ (string-to-number (match-string 0 cnt))))) + ((and + (string-match (rst-re 'rom-tag) cnt) + (save-match-data + (if (string-match (rst-re 'ltr-tag) cnt) ; Also a letter tag. + (save-excursion + ;; FIXME: Assumes one line list items without separating + ;; empty lines. + ;; Use of `rst-forward-line-looking-at' is very difficult + ;; here so don't do it. + (if (and (rst-forward-line-strict -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. + (let* ((old (match-string 0 cnt)) + (new (rst-arabic-to-roman + (1+ (rst-roman-to-arabic (upcase old)))))) + (if (equal old (upcase old)) + (upcase new) + (downcase new)))) + ((string-match (rst-re 'ltr-tag) cnt) + (char-to-string (1+ (string-to-char (match-string 0 cnt)))))) + sfx)))) + tab)) + +;; FIXME: At least the continuation may be folded into +;; `newline-and-indent`. However, this may not be wanted by everyone so +;; it should be possible to switch this off. +(defun rst-insert-list (&optional prefer-roman) + ;; testcover: ok. + "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 +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 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 + 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 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 +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 to set PREFER-ROMAN." + (interactive "P") + (save-match-data + (1value + (rst-forward-line-strict 0)) + ;; FIXME: Finds only tags in single line items. Multi-line items should be + ;; considered as well. + ;; Using `rst-forward-line-looking-at' is more complicated so don't do it. + (if (looking-at (rst-re 'itmany-beg-1)) + (rst-insert-list-continue + (buffer-substring-no-properties + (match-beginning 0) (match-beginning 1)) + (match-string 1) + (buffer-substring-no-properties (match-end 1) (match-end 0)) + prefer-roman) + (rst-insert-list-new-item)))) + +;; FIXME: This is wrong because it misses prefixed lines without intervening +;; new line. See `rst-straighten-bullets-region-BUGS' and +;; `rst-find-begs-BUGS'. +(defun rst-find-begs (beg end rst-re-beg) + ;; testcover: ok. + "Return the positions of begs in region BEG to END. +RST-RE-BEG is a `rst-re' argument and matched at the beginning of +a line. Return a list of (POINT . COLUMN) where POINT gives the +point after indentaton and COLUMN gives its column. The list is +ordererd by POINT." + (let (r) + (save-match-data + (save-excursion + ;; FIXME refactoring: Consider making this construct a macro looping + ;; over the lines. + (goto-char beg) + (1value + (rst-forward-line-strict 0)) + (while (< (point) end) + (let ((clm (current-indentation))) + ;; FIXME refactoring: Consider using `rst-forward-line-looking-at'. + (when (and + (looking-at (rst-re rst-re-beg)) ; Start found + (not (rst-forward-line-looking-at + -1 'lin-end + #'(lambda (mtcd) ; Previous line exists and is... + (and + (not mtcd) ; non-empty, + (<= (current-indentation) clm) ; less indented + (not (and (= (current-indentation) clm) + ; not a beg at same level. + (looking-at (rst-re rst-re-beg))))))))) + (back-to-indentation) + (push (cons (point) clm) r))) + (1value ; At least one line is moved in this loop. + (rst-forward-line-strict 1 end))))) + (nreverse r))) + +(defun rst-straighten-bullets-region (beg end) + ;; testcover: ok. + "Make all the bulleted list items in the region from BEG to END consistent. +Use this after you have merged multiple bulleted lists to make +them use the preferred bullet characters given by +`rst-preferred-bullets' for each level. If bullets are found on +levels beyond the `rst-preferred-bullets' list, they are not +modified." + (interactive "r") + (save-excursion + (let (clm2pnts) ; Map a column to a list of points at this column. + (rst-destructuring-dolist + ((point &rest column + &aux (found (assoc column clm2pnts))) + (rst-find-begs beg end 'bul-beg)) + (if found + ;;; (push point (cdr found)) ; FIXME: Doesn't work with `testcover'. + (setcdr found (cons point (cdr found))) ; Synonym. + (push (list column point) clm2pnts))) + (rst-destructuring-dolist + ((bullet _clm &rest pnts) + ;; Zip preferred bullets and sorted columns associating a bullet + ;; with a column and all the points this column is found. + (cl-mapcar #'(lambda (bullet clm2pnt) + (cons bullet clm2pnt)) + rst-preferred-bullets + (sort clm2pnts #'car-less-than-car))) + ;; Replace the bullets by the preferred ones. + (dolist (pnt pnts) + (goto-char pnt) + ;; FIXME: Assumes bullet to replace is a single char. + (delete-char 1) + (insert bullet)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Table of contents + +(defun rst-all-stn () + ;; testcover: ok. + "Return the hierarchical tree of sections as a top level `rst-Stn'. +Return value satisfies `rst-Stn-is-top' or is nil for no +sections." + (cdr (rst-remaining-stn (rst-all-ttls-with-level) -1))) + +(defun rst-remaining-stn (unprocessed expected) + ;; testcover: ok. + "Process the first entry of UNPROCESSED expected to be on level EXPECTED. +UNPROCESSED is the remaining list of (`rst-Ttl' . LEVEL) entries. +Return (REMAINING . STN) for the first entry of UNPROCESSED. +REMAINING is the list of still unprocessed entries. STN is a +`rst-Stn' or nil if UNPROCESSED is empty." + (if (not unprocessed) + (1value + (cons nil nil)) + (cl-destructuring-bind + ((ttl &rest level) &rest next + &aux fnd children) + unprocessed + (when (= level expected) + ;; Consume the current entry and create the current node with it. + (setq fnd ttl) + (setq unprocessed next)) + ;; Build the child nodes as long as they have deeper level. + (while (and unprocessed (> (cdar unprocessed) expected)) + (cl-destructuring-bind (remaining &rest stn) + (rst-remaining-stn unprocessed (1+ expected)) + (when stn + (push stn children)) + (setq unprocessed remaining))) + (cons unprocessed + (when (or fnd children) + (rst-Stn-new fnd expected (nreverse children))))))) + +(defun rst-stn-containing-point (stn &optional point) + ;; testcover: ok. + "Return `rst-Stn' in STN before POINT or nil if in no section. +POINT defaults to the current point. STN may be nil for no +section headers at all." + (when stn + (setq point (or point (point))) + (when (>= point (rst-Stn-get-title-beginning stn)) + ;; Point may be in this section or a child. + (let ((in-child (cl-find-if + #'(lambda (child) + (>= point (rst-Stn-get-title-beginning child))) + (rst-Stn-children stn) + :from-end t))) + (if in-child + (rst-stn-containing-point in-child point) + stn))))) + +(defgroup rst-toc nil + "Settings for reStructuredText table of contents." + :group 'rst + :version "21.1") + +(defcustom rst-toc-indent 2 + "Indentation for table-of-contents display. +Also used for formatting insertion, when numbering is disabled." + :type 'integer + :group 'rst-toc) +(rst-testcover-defcustom) + +(defcustom rst-toc-insert-style 'fixed + "Insertion style for table-of-contents. +Set this to one of the following values to determine numbering and +indentation style: +- `plain': no numbering (fixed indentation) +- `fixed': numbering, but fixed indentation +- `aligned': numbering, titles aligned under each other +- `listed': titles as list items" + :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) + +(defcustom rst-toc-insert-max-level nil + "If non-nil, maximum depth of the inserted TOC." + :type '(choice (const nil) integer) + :group 'rst-toc) +(rst-testcover-defcustom) + +(defun rst-toc-insert (&optional max-level) + ;; testcover: ok. + "Insert the table of contents of the current section at the current column. +By default the top level is ignored if there is only one, because +we assume that the document will have a single title. A numeric +prefix argument MAX-LEVEL overrides `rst-toc-insert-max-level'. +Text in the line beyond column is deleted." + (interactive "P") + (rst-reset-section-caches) + (let ((pt-stn (rst-stn-containing-point (rst-all-stn)))) + (when pt-stn + (let ((max + (if (and (integerp max-level) + (> (prefix-numeric-value max-level) 0)) + (prefix-numeric-value max-level) + rst-toc-insert-max-level)) + (ind (current-column)) + (buf (current-buffer)) + (tabs indent-tabs-mode) ; Copy buffer local value. + txt) + (setq txt + ;; Render to temporary buffer so markers are created correctly. + (with-temp-buffer + (rst-toc-insert-tree pt-stn buf rst-toc-insert-style max + rst-toc-link-keymap nil) + (goto-char (point-min)) + (when (rst-forward-line-strict 1) + ;; There are lines to indent. + (let ((indent-tabs-mode tabs)) + (indent-rigidly (point) (point-max) ind))) + (buffer-string))) + (unless (zerop (length txt)) + ;; Delete possible trailing text. + (delete-region (point) (line-beginning-position 2)) + (insert txt) + (backward-char 1)))))) + +(defun rst-toc-insert-link (pfx stn buf keymap) + ;; testcover: ok. + "Insert text of STN in BUF as a linked section reference at point. +If KEYMAP use this as keymap property. PFX is inserted before text." + (let ((beg (point))) + (insert pfx) + (insert (rst-Stn-get-text stn)) + (put-text-property beg (point) 'mouse-face 'highlight) + (insert "\n") + (put-text-property + beg (point) 'rst-toc-target + (set-marker (make-marker) (rst-Stn-get-title-beginning stn) buf)) + (when keymap + (put-text-property beg (point) 'keymap keymap)))) + +(defun rst-toc-get-link (link-buf link-pnt) + ;; testcover: ok. + "Return the link from text property at LINK-PNT in LINK-BUF." + (let ((mrkr (get-text-property link-pnt 'rst-toc-target link-buf))) + (unless mrkr + (error "No section on this line")) + (unless (buffer-live-p (marker-buffer mrkr)) + (error "Buffer for this section was killed")) + mrkr)) + +(defconst rst-toc-link-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'rst-toc-mouse-follow-link) + map) + "Keymap used for links in TOC.") + +(defun rst-toc-insert-tree (stn buf style depth keymap tgt-stn) + ;; testcover: ok. + "Insert table of contents of tree below top node STN in buffer BUF. +STYLE is the style to use and must be one of the symbols allowed +for `rst-toc-insert-style'. DEPTH is the maximum relative depth +from STN to insert or nil for no maximum depth. See +`rst-toc-insert-link' for KEYMAP. Return beginning of title line +if TGT-STN is rendered or nil if not rendered or TGT-STN is nil. +Just return nil if STN is nil." + (when stn + (rst-toc-insert-children (rst-Stn-children stn) buf style depth 0 "" keymap + tgt-stn))) + +(defun rst-toc-insert-children (children buf style depth indent numbering + keymap tgt-stn) + ;; testcover: ok. + "In the current buffer at point insert CHILDREN in BUF to table of contents. +See `rst-toc-insert-tree' for STYLE, DEPTH and TGT-STN. See +`rst-toc-insert-stn' for INDENT and NUMBERING. See +`rst-toc-insert-link' for KEYMAP." + (let ((count 1) + ;; Child numbering is done from the parent. + (num-fmt (format "%%%dd" + (1+ (floor (log (1+ (length children)) 10))))) + fnd) + (when (not (equal numbering "")) + ;; Add separating dot to existing numbering. + (setq numbering (concat numbering "."))) + (dolist (child children fnd) + (setq fnd + (or (rst-toc-insert-stn child buf style depth indent + (concat numbering (format num-fmt count)) + keymap tgt-stn) fnd)) + (cl-incf count)))) + +;; FIXME refactoring: Use `rst-Stn-buffer' instead of `buf'. +(defun rst-toc-insert-stn (stn buf style depth indent numbering keymap tgt-stn) + ;; testcover: ok. + "In the current buffer at point insert STN in BUF into table of contents. +See `rst-toc-insert-tree' for STYLE, DEPTH and TGT-STN. INDENT +is the indentation depth to use for STN. NUMBERING is the prefix +numbering for STN. See `rst-toc-insert-link' for KEYMAP." + (when (or (not depth) (> depth 0)) + (cl-destructuring-bind + (pfx add + &aux (fnd (when (and tgt-stn + (equal (rst-Stn-get-title-beginning stn) + (rst-Stn-get-title-beginning tgt-stn))) + (point)))) + (cond + ((eq style 'plain) + (list "" rst-toc-indent)) + ((eq style 'fixed) + (list (concat numbering rst-toc-insert-number-separator) + rst-toc-indent)) + ((eq style 'aligned) + (list (concat numbering rst-toc-insert-number-separator) + (+ (length numbering) + (length rst-toc-insert-number-separator)))) + ((eq style 'listed) + (list (format "%c " (car rst-preferred-bullets)) 2))) + ;; Indent using spaces so buffer characteristics like `indent-tabs-mode' + ;; do not matter. + (rst-toc-insert-link (concat (make-string indent ? ) pfx) stn buf keymap) + (or (rst-toc-insert-children (rst-Stn-children stn) buf style + (when depth + (1- depth)) + (+ indent add) numbering keymap tgt-stn) + fnd)))) + +(defun rst-toc-update () + ;; testcover: ok. + "Automatically find the contents section of a document and update. +Updates the inserted TOC if present. You can use this in your +file-write hook to always make it up-to-date automatically." + (interactive) + (save-match-data + (save-excursion + ;; Find and delete an existing comment after the first contents + ;; directive. Delete that region. + (goto-char (point-min)) + ;; FIXME: Should accept indentation of the whole block. + ;; We look for the following and the following only (in other words, if + ;; your syntax differs, this won't work.). + ;; + ;; .. contents:: [...anything here...] + ;; [:field: value]... + ;; .. + ;; XXXXXXXX + ;; XXXXXXXX + ;; [more lines] + ;; FIXME: Works only for the first of these tocs. There should be a + ;; fixed text after the comment such as "RST-MODE ELECTRIC TOC". + ;; May be parameters such as `max-level' should be appended. + (let ((beg (re-search-forward + (1value + (rst-re "^" 'exm-sta "contents" 'dcl-tag ".*\n" + "\\(?:" 'hws-sta 'fld-tag ".*\n\\)*" 'exm-tag)) + nil t)) + fnd) + (when + (and beg + (rst-forward-line-looking-at + 1 'lin-end + #'(lambda (mtcd) + (unless mtcd + (rst-apply-indented-blocks + (point) (point-max) (current-indentation) + #'(lambda (count _in-first _in-sub in-super in-empty + _relind) + (cond + ((or (> count 1) in-super)) + ((not in-empty) + (setq fnd (line-end-position)) + nil))))) + t))) + (when fnd + (delete-region beg fnd)) + (goto-char beg) + (insert "\n ") + ;; FIXME: Ignores an `max-level' given to the original + ;; `rst-toc-insert'. `max-level' could be rendered to the first + ;; line. + (rst-toc-insert))))) + ;; Note: always return nil, because this may be used as a hook. + nil) + +;; FIXME: Updating the toc on saving would be nice. However, this doesn't work +;; correctly: +;; +;; (add-hook 'write-contents-hooks 'rst-toc-update-fun) +;; (defun rst-toc-update-fun () +;; ;; Disable undo for the write file hook. +;; (let ((buffer-undo-list t)) (rst-toc-update) )) + +;; Maintain an alias for compatibility. +(defalias 'rst-toc-insert-update 'rst-toc-update) + +(defconst rst-toc-buffer-name "*Table of Contents*" + "Name of the Table of Contents buffer.") + +(defvar-local rst-toc-mode-return-wincfg nil + "Window configuration to which to return when leaving the TOC.") + +(defun rst-toc () + ;; testcover: ok. + "Display a table of contents for current buffer. +Displays all section titles found in the current buffer in a +hierarchical list. The resulting buffer can be navigated, and +selecting a section title moves the cursor to that section." + (interactive) + (rst-reset-section-caches) + (let* ((wincfg (list (current-window-configuration) (point-marker))) + (sectree (rst-all-stn)) + (target-stn (rst-stn-containing-point sectree)) + (target-buf (current-buffer)) + (buf (get-buffer-create rst-toc-buffer-name)) + target-pos) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (rst-toc-mode) + (delete-region (point-min) (point-max)) + ;; FIXME: Could use a customizable style. + (setq target-pos (rst-toc-insert-tree + sectree target-buf 'plain nil nil target-stn)))) + (display-buffer buf) + (pop-to-buffer buf) + (setq rst-toc-mode-return-wincfg wincfg) + (goto-char (or target-pos (point-min))))) + +;; Maintain an alias for compatibility. +(defalias 'rst-goto-section 'rst-toc-follow-link) + +(defun rst-toc-follow-link (link-buf link-pnt kill) + ;; testcover: ok. + "Follow the link to the section at LINK-PNT in LINK-BUF. +LINK-PNT and LINK-BUF default to the point in the current buffer. +With prefix argument KILL a TOC buffer is destroyed. Throw an +error if there is no working link at the given position." + (interactive "i\nd\nP") + (unless link-buf + (setq link-buf (current-buffer))) + ;; Do not catch errors from `rst-toc-get-link' because otherwise the error is + ;; suppressed and invisible in interactve use. + (let ((mrkr (rst-toc-get-link link-buf link-pnt))) + (condition-case nil + (rst-toc-mode-return kill) + ;; Catch errors when not in `toc-mode'. + (error nil)) + (pop-to-buffer (marker-buffer mrkr)) + (goto-char mrkr) + ;; FIXME: Should be a customizable number of lines from beginning or end of + ;; window just like the argument to `recenter`. It would be ideal if + ;; the adornment is always completely visible. + (recenter 5))) + +;; Maintain an alias for compatibility. +(defalias 'rst-toc-mode-goto-section 'rst-toc-mode-follow-link-kill) + +;; FIXME: Cursor before or behind the list must be handled properly; before the +;; list should jump to the top and behind the list to the last normal +;; paragraph. +(defun rst-toc-mode-follow-link-kill () + ;; testcover: ok. + "Follow the link to the section at point and kill the TOC buffer." + (interactive) + (rst-toc-follow-link (current-buffer) (point) t)) + +;; Maintain an alias for compatibility. +(defalias 'rst-toc-mode-mouse-goto 'rst-toc-mouse-follow-link) + +(defun rst-toc-mouse-follow-link (event kill) + ;; testcover: uncovered. + "In `rst-toc' mode, go to the occurrence whose line you click on. +EVENT is the input event. Kill TOC buffer if KILL." + (interactive "e\ni") + (rst-toc-follow-link (window-buffer (posn-window (event-end event))) + (posn-point (event-end event)) kill)) + +;; Maintain an alias for compatibility. +(defalias 'rst-toc-mode-mouse-goto-kill 'rst-toc-mode-mouse-follow-link-kill) + +(defun rst-toc-mode-mouse-follow-link-kill (event) + ;; testcover: uncovered. + "Same as `rst-toc-mouse-follow-link', but kill TOC buffer as well. +EVENT is the input event." + (interactive "e") + (rst-toc-mouse-follow-link event t)) + +;; Maintain an alias for compatibility. +(defalias 'rst-toc-quit-window 'rst-toc-mode-return) + +(defun rst-toc-mode-return (kill) + ;; testcover: ok. + "Leave the current TOC buffer and return to the previous environment. +With prefix argument KILL non-nil, kill the buffer instead of +burying it." + (interactive "P") + (unless rst-toc-mode-return-wincfg + (error "Not in a `toc-mode' buffer")) + (cl-destructuring-bind + (wincfg pos + &aux (toc-buf (current-buffer))) + rst-toc-mode-return-wincfg + (set-window-configuration wincfg) + (goto-char pos) + (if kill + (kill-buffer toc-buf) + (bury-buffer toc-buf)))) + +(defun rst-toc-mode-return-kill () + ;; testcover: uncovered. + "Like `rst-toc-mode-return' but kill TOC buffer." + (interactive) + (rst-toc-mode-return t)) + +(defvar rst-toc-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] #'rst-toc-mode-mouse-follow-link-kill) + (define-key map [mouse-2] #'rst-toc-mouse-follow-link) + (define-key map "\C-m" #'rst-toc-mode-follow-link-kill) + (define-key map "f" #'rst-toc-mode-follow-link-kill) + (define-key map "n" #'next-line) + (define-key map "p" #'previous-line) + (define-key map "q" #'rst-toc-mode-return) + (define-key map "z" #'rst-toc-mode-return-kill) + map) + "Keymap for `rst-toc-mode'.") + +(define-derived-mode rst-toc-mode special-mode "ReST-TOC" + "Major mode for output from \\[rst-toc], the table-of-contents for the document. +\\{rst-toc-mode-map}" + ;; FIXME: `revert-buffer-function` must be defined so `revert-buffer` works + ;; as expected for a special mode. In particular the referred buffer + ;; needs to be rescanned and the TOC must be updated accordingly. + ;; FIXME: Should contain the name of the buffer this is the toc of. + (setq header-line-format "Table of Contents")) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Section movement + +;; FIXME testcover: Use `testcover'. Mark up a function with sufficient test +;; coverage by a comment tagged with `testcover' after the +;; `defun'. Then move this comment. + +(defun rst-forward-section (offset) + "Jump forward OFFSET section titles ending up at the start of the title line. +OFFSET defaults to 1 and may be negative to move backward. An +OFFSET of 0 does not move unless point is inside a title. Go to +end or beginning of buffer if no more section titles in the desired +direction." + (interactive "p") + (rst-reset-section-caches) + (let* ((ttls (rst-all-ttls)) + (count (length ttls)) + (pnt (point)) + (contained nil) ; Title contains point (or is after point otherwise). + (found (or (cl-position-if + ;; Find a title containing or after point. + #'(lambda (ttl) + (let ((cmp (rst-Ttl-contains ttl pnt))) + (cond + ((= cmp 0) ; Title contains point. + (setq contained t) + t) + ((> cmp 0) ; Title after point. + t)))) + ttls) + ;; Point after all titles. + count)) + (target (+ found offset + ;; If point is in plain text found title is already one + ;; step forward. + (if (and (not contained) (>= offset 0)) -1 0)))) + (goto-char (cond + ((< target 0) + (point-min)) + ((>= target count) + (point-max)) + ((and (not contained) (= offset 0)) + ;; Point not in title and should not move - do not move. + pnt) + ((rst-Ttl-get-title-beginning (nth target ttls))))))) + +(defun rst-backward-section (offset) + "Like `rst-forward-section', except move backward by OFFSET." + (interactive "p") + (rst-forward-section (- offset))) + +;; FIXME: What is `allow-extend' for? See `mark-paragraph' for an explanation. +(defun rst-mark-section (&optional count allow-extend) + "Select COUNT sections around point. +Mark following sections for positive COUNT or preceding sections +for negative COUNT." + ;; Cloned from mark-paragraph. + (interactive "p\np") + (unless count (setq count 1)) + (when (zerop count) + (error "Cannot mark zero sections")) + (cond ((and allow-extend + (or (and (eq last-command this-command) (mark t)) + (use-region-p))) + (set-mark + (save-excursion + (goto-char (mark)) + (rst-forward-section count) + (point)))) + (t + (rst-forward-section count) + (push-mark nil t t) + (rst-forward-section (- count))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Indentation + +(defun rst-find-leftmost-column (beg 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-match-data + (save-excursion + (goto-char beg) + (1value + (rst-forward-line-strict 0)) + (while (< (point) end) + (unless (looking-at (rst-re 'lin-end)) + (setq mincol (if mincol + (min mincol (current-indentation)) + (current-indentation)))) + (rst-forward-line-strict 1 end))) + mincol))) + +;; 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 +;; prefer. + +(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." + :group 'rst + :package-version '(rst . "1.1.0")) + +(define-obsolete-variable-alias + 'rst-shift-basic-offset 'rst-indent-width "rst 1.0.0") +(defcustom rst-indent-width 2 + "Indentation when there is no more indentation point given." + :group 'rst-indent + :type '(integer)) +(rst-testcover-defcustom) + +(defcustom rst-indent-field 3 + "Indentation for first line after a field or 0 to always indent for content." + :group 'rst-indent + :package-version '(rst . "1.1.0") + :type '(integer)) +(rst-testcover-defcustom) + +(defcustom rst-indent-literal-normal 3 + "Default indentation for literal block after a markup on an own line." + :group 'rst-indent + :package-version '(rst . "1.1.0") + :type '(integer)) +(rst-testcover-defcustom) + +(defcustom rst-indent-literal-minimized 2 + "Default indentation for literal block after a minimized markup." + :group 'rst-indent + :package-version '(rst . "1.1.0") + :type '(integer)) +(rst-testcover-defcustom) + +(defcustom rst-indent-comment 3 + "Default indentation for first line of a comment." + :group 'rst-indent + :package-version '(rst . "1.1.0") + :type '(integer)) +(rst-testcover-defcustom) + +;; FIXME: Must consider other tabs: +;; * Line blocks +;; * Definition lists +;; * Option lists +(defun rst-line-tabs () + "Return tabs of the current line or nil for no tab. +The list is sorted so the tab where writing continues most likely +is the first one. Each tab is of the form (COLUMN . INNER). +COLUMN is the column of the tab. INNER is non-nil if this is an +inner tab. I.e. a tab which does come from the basic indentation +and not from inner alignment points." + (save-excursion + (rst-forward-line-strict 0) + (save-match-data + (unless (looking-at (rst-re 'lin-end)) + (back-to-indentation) + ;; 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 + ;; Item. + ((looking-at (rst-re '(:grp itmany-tag hws-sta) '(:grp "\\S ") "?")) + (when (match-string 2) + (push (list (match-beginning 2) 0 t) tabs))) + ;; Field. + ((looking-at (rst-re '(:grp fld-tag) '(:grp hws-tag) + '(:grp "\\S ") "?")) + (unless (zerop rst-indent-field) + (push (list (match-beginning 1) rst-indent-field t) tabs)) + (if (match-string 3) + (push (list (match-beginning 3) 0 t) tabs) + (if (zerop rst-indent-field) + (push (list (match-end 2) + (if (string= (match-string 2) "") 1 0) + t) + tabs)))) + ;; Directive. + ((looking-at (rst-re 'dir-sta-3 '(:grp "\\S ") "?")) + (push (list (match-end 1) 0 t) tabs) + (unless (string= (match-string 2) "") + (push (list (match-end 2) 0 t) tabs)) + (when (match-string 4) + (push (list (match-beginning 4) 0 t) tabs))) + ;; Footnote or citation definition. + ((looking-at (rst-re 'fnc-sta-2 '(:grp "\\S ") "?")) + (push (list (match-end 1) 0 t) tabs) + (when (match-string 3) + (push (list (match-beginning 3) 0 t) tabs))) + ;; Comment. + ((looking-at (rst-re 'cmt-sta-1)) + (push (list (point) rst-indent-comment t) tabs))) + ;; Start of literal block. + (when (looking-at (rst-re 'lit-sta-2)) + (cl-destructuring-bind (point offset _inner) (car tabs) + (push (list point + (+ offset + (if (match-string 1) + rst-indent-literal-minimized + rst-indent-literal-normal)) + t) + tabs))) + (mapcar (cl-function + (lambda ((point offset inner)) + (goto-char point) + (cons (+ (current-column) offset) inner))) + tabs)))))) + +(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." + ;; FIXME: See test `indent-for-tab-command-BUGS`. + (save-excursion + (goto-char pt) + (let (leftmost ; Leftmost column found so far. + innermost ; Leftmost column for inner tab. + tablist) + (while (and (rst-forward-line-strict -1) + (or (not leftmost) + (> leftmost 0))) + (let ((tabs (rst-line-tabs))) + (when tabs + (let ((leftcol (apply #'min (mapcar #'car tabs)))) + ;; Consider only lines indented less or same if not INNERMOST. + (when (or (not leftmost) + (< leftcol leftmost) + (and (not innermost) (= leftcol leftmost))) + (rst-destructuring-dolist ((column &rest inner) tabs) + (when (or + (and (not inner) + (or (not leftmost) + (< column leftmost))) + (and inner + (or (not innermost) + (< column innermost)))) + (setq tablist (cl-adjoin column tablist)))) + (setq innermost (if (cl-some #'cdr tabs) ; Has inner. + leftcol + innermost)) + (setq leftmost leftcol)))))) + (nreverse tablist)))) + +(defun rst-indent-line (&optional dflt) + "Indent current line to next best reStructuredText tab. +The next best tab is taken from the tab list returned by +`rst-compute-tabs' which is used in a cyclic manner. If the +current indentation does not end on a tab use the first one. If +the current indentation is on a tab use the next tab. This allows +a repeated use of \\[indent-for-tab-command] to cycle through all +possible tabs. If no indentation is possible return `noindent' or +use DFLT. Return the indentation indented to. When point is in +indentation it ends up at its end. Otherwise the point is kept +relative to the content." + (let* ((pt (point-marker)) + (cur (current-indentation)) + (clm (current-column)) + (tabs (rst-compute-tabs (point))) + (fnd (cl-position cur tabs :test #'equal)) + ind) + (if (and (not tabs) (not dflt)) + 'noindent + (if (not tabs) + (setq ind dflt) + (if (not fnd) + (setq fnd 0) + (setq fnd (1+ fnd)) + (if (>= fnd (length tabs)) + (setq fnd 0))) + (setq ind (nth fnd tabs))) + (indent-line-to ind) + (if (> clm cur) + (goto-char pt)) + (set-marker pt nil) + ind))) + +(defun rst-shift-region (beg end cnt) + "Shift region BEG to END by CNT tabs. +Shift by one tab to the right (CNT > 0) or left (CNT < 0) or +remove all indentation (CNT = 0). A tab is taken from the text +above. If no suitable tab is found `rst-indent-width' is used." + (interactive "r\np") + (let ((tabs (sort (rst-compute-tabs beg) + #'(lambda (x y) + (<= x y)))) + (leftmostcol (rst-find-leftmost-column beg end))) + (when (or (> leftmostcol 0) (> cnt 0)) + ;; Apply the indent. + (indent-rigidly + beg end + (if (zerop cnt) + (- leftmostcol) + ;; Find the next tab after the leftmost column. + (let* ((cmp (if (> cnt 0) #'> #'<)) + (tabs (if (> cnt 0) tabs (reverse tabs))) + (len (length tabs)) + (dir (cl-signum cnt)) ; Direction to take. + (abs (abs cnt)) ; Absolute number of steps to take. + ;; Get the position of the first tab beyond leftmostcol. + (fnd (cl-position-if #'(lambda (elt) + (funcall cmp elt leftmostcol)) + tabs)) + ;; Virtual position of tab. + (pos (+ (or fnd len) (1- abs))) + (tab (if (< pos len) + ;; Tab exists - use it. + (nth pos tabs) + ;; Column needs to be computed. + (let ((col (+ (or (car (last tabs)) leftmostcol) + ;; Base on last known column. + (* (- pos (1- len)) ; Distance left. + dir ; Direction to take. + rst-indent-width)))) + (if (< col 0) 0 col))))) + (- tab leftmostcol))))))) + +;; FIXME: A paragraph with an (incorrectly) indented second line is not filled +;; correctly:: +;; +;; Some start +;; continued wrong +(defun rst-adaptive-fill () + "Return fill prefix found at point. +Value for `adaptive-fill-function'." + (save-match-data + (let ((fnd (if (looking-at adaptive-fill-regexp) + (match-string-no-properties 0)))) + (if (save-match-data + (not (string-match comment-start-skip fnd))) + ;; An non-comment prefix is fine. + fnd + ;; Matches a comment - return whitespace instead. + (make-string (- + (save-excursion + (goto-char (match-end 0)) + (current-column)) + (save-excursion + (goto-char (match-beginning 0)) + (current-column))) ? ))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Comments + +(defun rst-comment-line-break (&optional soft) + "Break line and indent, continuing reStructuredText comment if within one. +Value for `comment-line-break-function'. If SOFT use soft +newlines as mandated by `comment-line-break-function'." + (if soft + (insert-and-inherit ?\n) + (newline 1)) + (save-excursion + (forward-char -1) + (delete-horizontal-space)) + (delete-horizontal-space) + (let ((tabs (rst-compute-tabs (point)))) + (when tabs + (indent-line-to (car tabs))))) + +(defun rst-comment-indent () + "Return indentation for current comment line." + (car (rst-compute-tabs (point)))) + +(defun rst-comment-insert-comment () + "Insert a comment in the current line." + (rst-indent-line 0) + (insert comment-start)) + +(defun rst-comment-region (beg end &optional arg) + "Comment or uncomment the current region. +Region is from BEG to END. Uncomment if ARG." + (save-excursion + (if (consp arg) + (rst-uncomment-region beg end arg) + (goto-char beg) + (rst-forward-line-strict 0) + (let ((ind (current-indentation)) + (bol (point))) + (indent-rigidly bol end rst-indent-comment) + (goto-char bol) + (open-line 1) + (indent-line-to ind) + (insert (comment-string-strip comment-start t t)))))) + +(defun rst-uncomment-region (beg end &optional _arg) + "Uncomment the current region. +Region is from BEG to END. _ARG is ignored" + (save-excursion + (goto-char beg) + (rst-forward-line-strict 0) + (let ((bol (point))) + (rst-forward-line-strict 1 end) + (indent-rigidly (point) end (- rst-indent-comment)) + (goto-char bol) + (rst-delete-entire-line 0)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 +;; the possible outputs. +;; +;; 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 paragraph. A non-empty line with less +indentation than IND terminates the current paragraph. FUN is +applied to each line like this + + (FUN COUNT IN-FIRST IN-SUB IN-SUPER IN-EMPTY RELIND) + +COUNT is 0 before the first paragraph and increments for every +paragraph found on level IND. IN-FIRST is non-nil if this is the +first line of such a paragraph. IN-SUB is non-nil if this line +is part of a sub-block while IN-SUPER is non-nil of this line is +part of a less indented block (super-block). IN-EMPTY is non-nil +if this line is empty where an empty line is considered being +part of the previous block. RELIND is nil for an empty line, 0 +for a line indented to IND, and the positive or negative number +of columns more or less indented otherwise. When FUN is called +point is immediately behind indentation of that line. FUN may +change everything as long as a marker at END and at the beginning +of the following line is handled correctly by the change. A +non-nil return value from FUN breaks the loop and is returned. +Otherwise return nil." + (let ((endm (copy-marker end t)) + (count 0) ; Before first indented block. + (nxt (when (< beg end) + (copy-marker beg t))) + (broken t) + in-sub in-super stop) + (save-match-data + (save-excursion + (while (and (not stop) nxt) + (set-marker + (goto-char nxt) nil) + (setq nxt (save-excursion + ;; FIXME refactoring: Replace `(forward-line) + ;; (back-to-indentation)` by + ;; `(forward-to-indentation)` + (when (and (rst-forward-line-strict 1 endm) + (< (point) endm)) + (copy-marker (point) t)))) + (back-to-indentation) + (let ((relind (- (current-indentation) ind)) + (in-empty (looking-at (rst-re 'lin-end))) + in-first) + (cond + (in-empty + (setq relind nil)) + ((< relind 0) + (setq in-sub nil) + (setq in-super t)) + ((> relind 0) + (setq in-sub t) + (setq in-super nil)) + (t ; Non-empty line in indented block. + (when (or broken in-sub in-super) + (setq in-first t) + (cl-incf count)) + (setq in-sub nil) + (setq in-super nil))) + (save-excursion + (setq + stop + (funcall fun count in-first in-sub in-super in-empty relind))) + (setq broken in-empty))) + (set-marker endm nil) + stop)))) + +(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 ((enum 0) + (indent "")) + (rst-apply-indented-blocks + beg end (rst-find-leftmost-column beg end) + #'(lambda (count in-first in-sub in-super in-empty _relind) + (cond + (in-empty) + (in-super) + ((zerop count)) + (in-sub + (insert indent)) + ((or in-first all) + (let ((tag (format "%d. " (cl-incf enum)))) + (setq indent (make-string (length tag) ? )) + (insert tag))) + (t + (insert indent))) + nil)))) + +;; 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") + (unless rst-preferred-bullets + (error "No preferred bullets defined")) + (let* ((bul (format "%c " (car rst-preferred-bullets))) + (indent (make-string (length bul) ? ))) + (rst-apply-indented-blocks + beg end (rst-find-leftmost-column beg end) + #'(lambda (count in-first in-sub in-super in-empty _relind) + (cond + (in-empty) + (in-super) + ((zerop count)) + (in-sub + (insert indent)) + ((or in-first all) + (insert bul)) + (t + (insert indent))) + nil)))) + +;; FIXME: Does not deal with a varying number of digits appropriately. +;; FIXME: Does not deal with multiple levels independently. +;; FIXME: Does not indent a multiline item correctly. +(defun rst-convert-bullets-to-enumeration (beg end) + "Convert the bulleted and enumerated items in the region to enumerated lists. +Renumber as necessary. Region is from BEG to END." + (interactive "r") + (let ((count 1)) + (save-match-data + (save-excursion + (dolist (marker (mapcar + (cl-function + (lambda ((pnt &rest clm)) + (copy-marker pnt))) + (rst-find-begs beg end 'itmany-beg-1))) + (set-marker + (goto-char marker) nil) + (looking-at (rst-re 'itmany-beg-1)) + (replace-match (format "%d." count) nil nil nil 1) + (cl-incf count)))))) + +(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 ((ind (rst-find-leftmost-column beg end))) + (rst-apply-indented-blocks + beg end ind + #'(lambda (_count _in-first _in-sub in-super in-empty _relind) + (when (and (not in-super) (or with-empty (not in-empty))) + (move-to-column ind t) + (insert "| ")) + nil)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Font lock + +(require 'font-lock) + +;; FIXME: The obsolete variables need to disappear. + +;; The following versions have been done inside Emacs and should not be +;; replaced by `:package-version' attributes until a change. + +(defgroup rst-faces nil "Faces used in Rst Mode." + :group 'rst + :group 'faces + :version "21.1") + +(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)) +(rst-testcover-defcustom) +(make-obsolete-variable 'rst-block-face + "customize the face `rst-block' instead." + "24.1") + +(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)) +(rst-testcover-defcustom) +(make-obsolete-variable 'rst-external-face + "customize the face `rst-external' instead." + "24.1") + +(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)) +(rst-testcover-defcustom) +(make-obsolete-variable 'rst-definition-face + "customize the face `rst-definition' instead." + "24.1") + +;; 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)) +(rst-testcover-defcustom) +(make-obsolete-variable 'rst-directive-face + "customize the face `rst-directive' instead." + "24.1") + +(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)) +(rst-testcover-defcustom) +(make-obsolete-variable 'rst-comment-face + "customize the face `rst-comment' instead." + "24.1") + +(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)) +(rst-testcover-defcustom) +(make-obsolete-variable 'rst-emphasis1-face + "customize the face `rst-emphasis1' instead." + "24.1") + +(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)) +(rst-testcover-defcustom) +(make-obsolete-variable 'rst-emphasis2-face + "customize the face `rst-emphasis2' instead." + "24.1") + +(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)) +(rst-testcover-defcustom) +(make-obsolete-variable 'rst-literal-face + "customize the face `rst-literal' instead." + "24.1") + +(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)) +(rst-testcover-defcustom) +(make-obsolete-variable 'rst-reference-face + "customize the face `rst-reference' instead." + "24.1") + +(defface rst-transition '((t :inherit font-lock-keyword-face)) + "Face used for a transition." + :package-version '(rst . "1.3.0") + :group 'rst-faces) + +(defface rst-adornment '((t :inherit font-lock-keyword-face)) + "Face used for the adornment of a section header." + :package-version '(rst . "1.3.0") + :group 'rst-faces) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(dolist (var '(rst-level-face-max rst-level-face-base-color + rst-level-face-base-light + rst-level-face-format-light + rst-level-face-step-light + rst-level-1-face + rst-level-2-face + rst-level-3-face + rst-level-4-face + rst-level-5-face + rst-level-6-face)) + (make-obsolete-variable var "customize the faces `rst-level-*' instead." + "24.3")) + +;; Define faces for the first 6 levels. More levels are possible, however. +(defface rst-level-1 '((((background light)) (:background "grey85")) + (((background dark)) (:background "grey15"))) + "Default face for section title text at level 1." + :package-version '(rst . "1.4.0")) + +(defface rst-level-2 '((((background light)) (:background "grey78")) + (((background dark)) (:background "grey22"))) + "Default face for section title text at level 2." + :package-version '(rst . "1.4.0")) + +(defface rst-level-3 '((((background light)) (:background "grey71")) + (((background dark)) (:background "grey29"))) + "Default face for section title text at level 3." + :package-version '(rst . "1.4.0")) + +(defface rst-level-4 '((((background light)) (:background "grey64")) + (((background dark)) (:background "grey36"))) + "Default face for section title text at level 4." + :package-version '(rst . "1.4.0")) + +(defface rst-level-5 '((((background light)) (:background "grey57")) + (((background dark)) (:background "grey43"))) + "Default face for section title text at level 5." + :package-version '(rst . "1.4.0")) + +(defface rst-level-6 '((((background light)) (:background "grey50")) + (((background dark)) (:background "grey50"))) + "Default face for section title text at level 6." + :package-version '(rst . "1.4.0")) + +(defcustom rst-adornment-faces-alist + '((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 need levels beyond 6 you have to define faces +of your own." + :group 'rst-faces + :type '(alist + :key-type + (choice + (integer :tag "Section level") + (const :tag "transitions" t) + (const :tag "section title adornment" nil)) + :value-type (face))) +(rst-testcover-defcustom) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar rst-font-lock-keywords + ;; The reST-links in the comments below all relate to sections in + ;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html. + `(;; FIXME: Block markup is not recognized in blocks after explicit markup + ;; start. + + ;; Simple `Body Elements`_ + ;; `Bullet Lists`_ + ;; FIXME: A bullet directly after a field name is not recognized. + (,(rst-re 'lin-beg '(:grp bul-sta)) + 1 rst-block-face) + ;; `Enumerated Lists`_ + (,(rst-re 'lin-beg '(:grp enmany-sta)) + 1 rst-block-face) + ;; `Definition Lists`_ + ;; FIXME: missing. + ;; `Field Lists`_ + (,(rst-re 'lin-beg '(:grp fld-tag) 'bli-sfx) + 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) + ;; `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) + + ;; `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)) + ;; `Directives`_ / `Substitution Definitions`_ + (,(rst-re 'lin-beg 'dir-sta-3) + (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) + (,(rst-re 'lin-beg '(:grp "__") 'bli-sfx) + 1 rst-definition-face) + + ;; All `Inline Markup`_ + ;; Most of them may be multiline though this is uninteresting. + + ;; 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) + ;; `Emphasis`_ + (,(rst-re 'ilm-pfx '(:grp "\\*" ilcast-tag "\\*") 'ilm-sfx) + 1 rst-emphasis1-face) + ;; `Inline Literals`_ + (,(rst-re 'ilm-pfx '(:grp "``" ilcbkq-tag "``") 'ilm-sfx) + 1 rst-literal-face) + ;; `Inline Internal Targets`_ + (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx) + 1 rst-definition-face) + ;; `Hyperlink References`_ + ;; FIXME: `Embedded URIs and Aliases`_ not considered. + ;; FIXME: Directly adjacent marked up words are not fontified correctly + ;; unless they are not separated by two spaces: foo_ bar_. + (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`") + (:seq "\\sw" (:alt "\\sw" "-") "+\\sw")) + "__?") 'ilm-sfx) + 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)) + ;; `Footnote References`_ / `Citation References`_ + (,(rst-re 'ilm-pfx '(:grp fnc-tag "_") 'ilm-sfx) + 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) + ;; `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) + (,(rst-re 'ilm-pfx '(:grp sym-tag "@" sym-tag ) 'ilm-sfx) + 1 rst-definition-face) + + ;; Do all block fontification as late as possible so 'append works. + + ;; Sections_ / Transitions_ + ;; For sections this is multiline. + (,(rst-re 'ado-beg-2-1) + (rst-font-lock-handle-adornment-matcher + (rst-font-lock-handle-adornment-pre-match-form + (match-string-no-properties 1) (match-end 1)) + nil + (1 (cdr (assoc nil rst-adornment-faces-alist)) append t) + (2 (cdr (assoc rst-font-lock-adornment-level + rst-adornment-faces-alist)) append t) + (3 (cdr (assoc nil rst-adornment-faces-alist)) append t))) + + ;; FIXME: FACESPEC could be used instead of ordinary faces to set + ;; 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) + (rst-font-lock-find-unindented-line-match + (rst-font-lock-find-unindented-line-limit (match-end 1)) + nil + (0 rst-comment-face append))) + (,(rst-re 'lin-beg '(:grp exm-tag) '(:grp hws-tag) "$") + (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))) + + ;; FIXME: This is not rendered as comment:: + ;; .. .. list-table:: + ;; :stub-columns: 1 + ;; :header-rows: 1 + + ;; FIXME: This is rendered wrong:: + ;; + ;; xxx yyy:: + ;; + ;; ----|> KKKKK <|---- + ;; / \ + ;; -|> AAAAAAAAAAPPPPPP <|- -|> AAAAAAAAAABBBBBBB <|- + ;; | | | | + ;; | | | | + ;; PPPPPP PPPPPPDDDDDDD BBBBBBB PPPPPPBBBBBBB + ;; + ;; Indentation needs to be taken from the line with the ``::`` and not from + ;; the first content line. + + ;; `Indented Literal Blocks`_ + ;; This is multiline. + (,(rst-re 'lin-beg 'lit-sta-2) + (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))) + + ;; FIXME: `Quoted Literal Blocks`_ missing. + ;; This is multiline. + + ;; `Doctest Blocks`_ + ;; FIXME: This is wrong according to the specification: + ;; + ;; Doctest blocks are text blocks which begin with ">>> ", the Python + ;; interactive interpreter main prompt, and end with a blank line. + ;; Doctest blocks are treated as a special case of literal blocks, + ;; without requiring the literal block syntax. If both are present, the + ;; literal block syntax takes priority over Doctest block syntax: + ;; + ;; This is an ordinary paragraph. + ;; + ;; >>> print 'this is a Doctest block' + ;; this is a Doctest block + ;; + ;; The following is a literal block:: + ;; + ;; >>> This is not recognized as a doctest block by + ;; reStructuredText. It *will* be recognized by the doctest + ;; module, though! + ;; + ;; Indentation is not required for doctest blocks. + (,(rst-re 'lin-beg '(:grp (:alt ">>>" ell-tag)) '(:grp ".+")) + (1 rst-block-face) + (2 rst-literal-face))) + "Keywords to highlight in rst mode.") + +(defvar font-lock-beg) +(defvar font-lock-end) + +(defun rst-font-lock-extend-region () + "Extend the font-lock region if it might be in a multi-line construct. +Return non-nil if so. Font-lock region is from `font-lock-beg' +to `font-lock-end'." + (let ((r (rst-font-lock-extend-region-internal font-lock-beg font-lock-end))) + (when r + (setq font-lock-beg (car r)) + (setq font-lock-end (cdr r)) + t))) + +(defun rst-font-lock-extend-region-internal (beg end) + "Check the region BEG / END for being in the middle of a multi-line construct. +Return nil if not or a cons with new values for BEG / END" + (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))))) + +;; FIXME refactoring: Use `rst-forward-line-strict' instead. +(defun rst-forward-line (&optional n) + "Like `forward-line' but always end up in column 0 and return accordingly. +Move N lines forward just as `forward-line'." + (let ((left (forward-line n))) + (if (bolp) + left + ;; FIXME: This may move back for positive n - is this desired? + (forward-line 0) + (- left (cl-signum n))))) + +;; FIXME: If a single line is made a section header by `rst-adjust' the header +;; is not always fontified immediately. +(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 indentation 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-match-data + (save-excursion + (let ( ; Non-empty non-indented line, explicit markup tag or literal + ; block tag. + (stop-re (rst-re '(:alt "[^ \t\n]" + (:seq hws-tag exm-tag) + (:seq ".*" dcl-tag lin-end))))) + ;; The comments below are for dir == -1 / dir == 1. + (goto-char pt) + (rst-forward-line-strict 0) + (setq pt (point)) + (while (and (not (looking-at stop-re)) + (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-1)) ; 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-1)) ; 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 + +(defun rst-forward-indented-block (&optional column limit) + ;; testcover: ok. + "Move forward across one indented block. +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 + (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)))) + +(defvar rst-font-lock-find-unindented-line-begin nil + "Beginning of the match if `rst-font-lock-find-unindented-line-end'.") + +(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'.") + +(defun rst-font-lock-find-unindented-line-limit (ind-pnt) + "Find the next unindented line relative to indentation at IND-PNT. +Return this point, the end of the buffer or nil if nothing found. +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." + (setq rst-font-lock-find-unindented-line-begin ind-pnt) + (setq rst-font-lock-find-unindented-line-end + (save-match-data + (save-excursion + (when (not (numberp ind-pnt)) + ;; Find indentation point in next line if any. + (setq ind-pnt + ;; FIXME: Should be refactored to two different functions + ;; giving their result to this function, may be + ;; integrated in caller. + (save-match-data + (let ((cur-ind (current-indentation))) + (if (eq ind-pnt 'next) + (when (and (rst-forward-line-strict 1 (point-max)) + (< (point) (point-max))) + ;; Not at EOF. + (setq rst-font-lock-find-unindented-line-begin + (point)) + (when (and (not (looking-at (rst-re 'lin-end))) + (> (current-indentation) cur-ind)) + ;; Use end of indentation if non-empty line. + (looking-at (rst-re 'hws-tag)) + (match-end 0))) + ;; Skip until non-empty line or EOF. + (while (and (rst-forward-line-strict 1 (point-max)) + (< (point) (point-max)) + (looking-at (rst-re 'lin-end)))) + (when (< (point) (point-max)) + ;; Not at EOF. + (setq rst-font-lock-find-unindented-line-begin + (point)) + (when (> (current-indentation) cur-ind) + ;; Indentation bigger than line of departure. + (looking-at (rst-re 'hws-tag)) + (match-end 0)))))))) + (when ind-pnt + (goto-char ind-pnt) + (or (rst-forward-indented-block nil (point-max)) + (point-max))))))) + +(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." + (when rst-font-lock-find-unindented-line-end + (set-match-data + (list rst-font-lock-find-unindented-line-begin + rst-font-lock-find-unindented-line-end)) + (put-text-property rst-font-lock-find-unindented-line-begin + rst-font-lock-find-unindented-line-end + 'font-lock-multiline t) + ;; Make sure this is called only once. + (setq rst-font-lock-find-unindented-line-end nil) + t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Adornments + +(defvar rst-font-lock-adornment-level nil + "Storage for `rst-font-lock-handle-adornment-matcher'. +Either section level of the current adornment or t for a transition.") + +(defun rst-adornment-level (ado) + "Return section level for ADO or t for a transition. +If ADO is found in the hierarchy return its level. Otherwise +return a level one beyond the existing hierarchy." + (if (rst-Ado-is-transition ado) + t + (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) + (1+ (or (rst-Ado-position ado hier) + (length hier)))))) + +(defvar rst-font-lock-adornment-match nil + "Storage for match for current adornment. +Set by `rst-font-lock-handle-adornment-pre-match-form'. Also used +as a trigger for `rst-font-lock-handle-adornment-matcher'.") + +(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 +matched. ADO-END is the point where ADO ends. Return the point +where the whole adorned construct ends. + +Called as a PRE-MATCH-FORM in the sense of `font-lock-keywords'." + (let ((ttl (rst-classify-adornment ado ado-end))) + (if (not ttl) + (setq rst-font-lock-adornment-level nil + rst-font-lock-adornment-match nil) + (setq rst-font-lock-adornment-level + (rst-adornment-level (rst-Ttl-ado ttl))) + (setq rst-font-lock-adornment-match (rst-Ttl-match ttl)) + (goto-char (rst-Ttl-get-beginning ttl)) + (rst-Ttl-get-end ttl)))) + +(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 +called or no match is found. Return non-nil if match was found. + +Called as a MATCHER in the sense of `font-lock-keywords'. +_LIMIT is not used but mandated by the caller." + (let ((match rst-font-lock-adornment-match)) + ;; May run only once - enforce this. + (setq rst-font-lock-adornment-match nil) + (when match + (set-match-data match) + (goto-char (match-end 0)) + (put-text-property (match-beginning 0) (match-end 0) + 'font-lock-multiline t) + t))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Compilation + +(defgroup rst-compile nil + "Settings for support of conversion of reStructuredText +document with \\[rst-compile]." + :group 'rst + :version "21.1") + +(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)) + ;; FIXME: Add at least those converters officially supported like `rst2odt' + ;; and `rst2man'. + ;; FIXME: To make this really useful there should be a generic command the + ;; user gives one of the symbols and this way select the conversion to + ;; run. This should replace the toolset stuff somehow. + ;; FIXME: Allow a template for the conversion command so `rst2pdf ... -o ...' + ;; can be supported. + "Table describing the command to use for each tool-set. +An association list of the tool-set 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." + ;; FIXME: These are not options but symbols which may be referenced by + ;; `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" + (file :tag "Command") + (string :tag "File extension") + (choice :tag "Command options" + (const :tag "No options" nil) + (string :tag "Options")))) + :group 'rst-compile + :package-version "1.2.0") +(rst-testcover-defcustom) + +;; FIXME: Must be defcustom. +(defvar rst-compile-primary-toolset 'html + "The default tool-set for `rst-compile'.") + +;; FIXME: Must be defcustom. +(defvar rst-compile-secondary-toolset 'latex + "The default tool-set for `rst-compile' with a prefix argument.") + +(defun rst-compile-find-conf () + "Look for the configuration file in the parents of the current path." + (interactive) + (let ((file-name "docutils.conf") + (buffer-file (buffer-file-name))) + ;; Move up in the dir hierarchy till we find a change log file. + (let* ((dir (file-name-directory buffer-file)) + (prevdir nil)) + (while (and (or (not (string= dir prevdir)) + (setq dir nil) + nil) + (not (file-exists-p (concat dir file-name)))) + ;; Move up to the parent dir and try again. + (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)))) + +(require 'compile) + +(defun rst-compile (&optional use-alt) + "Compile command to convert reST document into some output file. +Attempts to find configuration file, if it can, overrides the +options. There are two commands to choose from; with USE-ALT, +select the alternative tool-set." + (interactive "P") + ;; Note: maybe we want to check if there is a Makefile too and not do anything + ;; if that is the case. I dunno. + (cl-destructuring-bind + (command extension options + &aux (conffile (rst-compile-find-conf)) + (bufname (file-name-nondirectory buffer-file-name))) + (cdr (assq (if use-alt + rst-compile-secondary-toolset + rst-compile-primary-toolset) + rst-compile-toolsets)) + ;; Set compile-command before invocation of compile. + (setq-local + compile-command + (mapconcat + #'identity + (list command + (or options "") + (if conffile + (concat "--config=" (shell-quote-argument conffile)) + "") + (shell-quote-argument bufname) + (shell-quote-argument (concat (file-name-sans-extension bufname) + extension))) + " ")) + ;; Invoke the compile command. + (if (or compilation-read-command use-alt) + (call-interactively #'compile) + (compile compile-command)))) + +(defun rst-compile-alt-toolset () + "Compile command with the alternative tool-set." + (interactive) + (rst-compile t)) + +(defun rst-compile-pseudo-region () + "Show pseudo-XML rendering. +Rendering is done of the current active region, or of the entire +buffer, if the region is not selected." + ;; FIXME: The region should be given interactively. + (interactive) + (with-output-to-temp-buffer "*pseudoxml*" + (shell-command-on-region + (if mark-active (region-beginning) (point-min)) + (if mark-active (region-end) (point-max)) + (cadr (assq 'pseudoxml rst-compile-toolsets)) + standard-output))) + +;; FIXME: Should be integrated in `rst-compile-toolsets'. +(defvar rst-pdf-program "xpdf" + "Program used to preview PDF files.") + +(defun rst-compile-pdf-preview () + "Convert the document to a PDF file and launch a preview program." + (interactive) + (let* ((tmp-filename (make-temp-file "rst_el" nil ".pdf")) + (command (format "%s %s %s && %s %s ; rm %s" + (cadr (assq 'pdf rst-compile-toolsets)) + buffer-file-name tmp-filename + rst-pdf-program tmp-filename tmp-filename))) + (start-process-shell-command "rst-pdf-preview" nil command) + ;; Note: you could also use (compile command) to view the compilation + ;; output. + )) + +;; FIXME: Should be integrated in `rst-compile-toolsets' defaulting to +;; something like `browse-url'. +(defvar rst-slides-program "firefox" + "Program used to preview S5 slides.") + +(defun rst-compile-slides-preview () + "Convert the document to an S5 slide presentation and launch a preview program." + (interactive) + (let* ((tmp-filename (make-temp-file "rst_el" nil ".html")) + (command (format "%s %s %s && %s %s ; rm %s" + (cadr (assq 's5 rst-compile-toolsets)) + buffer-file-name tmp-filename + rst-slides-program tmp-filename tmp-filename))) + (start-process-shell-command "rst-slides-preview" nil command) + ;; Note: you could also use (compile command) to view the compilation + ;; output. + )) + +;; FIXME: Add `rst-compile-html-preview'. + +;; FIXME: Add support for `restview` (http://mg.pov.lt/restview/). May be a +;; more general facility for calling commands on a reST file would make +;; sense. + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Imenu support + +;; FIXME: Consider a key binding. A key binding needs to definitely switch on +;; `which-func-mode' - i.e. `which-func-modes' must be set properly. + +;; Based on ideas from Masatake YAMATO . + +(defun rst-imenu-convert-cell (stn) + "Convert a STN to an Imenu index node and return it." + (let ((ttl (rst-Stn-ttl stn)) + (children (rst-Stn-children stn)) + (pos (rst-Stn-get-title-beginning stn)) + (txt (rst-Stn-get-text stn "")) + (pfx " ") + (sfx "") + name) + (when ttl + (let ((hdr (rst-Ttl-hdr ttl))) + (setq pfx (char-to-string (rst-Hdr-get-char hdr))) + (when (rst-Hdr-is-over-and-under hdr) + (setq sfx pfx)))) + ;; 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. + (setq name (format "%s%s%s" pfx txt sfx)) + (cons name ; The name of the entry. + (if children + (cons ; The entry has a submenu. + (cons name pos) ; The entry itself. + (mapcar #'rst-imenu-convert-cell children)) ; The children. + pos)))) ; The position of a plain entry. + +;; 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 ((root (rst-all-stn))) + (when root + (mapcar #'rst-imenu-convert-cell (rst-Stn-children root))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Convenience functions + +;; FIXME: Unbound command - should be bound or removed. +(defun rst-replace-lines (fromchar tochar) + "Replace flush-left lines of FROMCHAR with equal-length lines of TOCHAR." + (interactive "\ +cSearch for flush-left lines of char: +cand replace with char: ") + (save-excursion + (let ((searchre (rst-re "^" fromchar "+\\( *\\)$")) + (found 0)) + (while (search-forward-regexp searchre nil t) + (setq found (1+ found)) + (goto-char (match-beginning 1)) + (let ((width (current-column))) + (rst-delete-entire-line 0) + (insert-char tochar width))) + (message "%d lines replaced." found)))) + +;; FIXME: Unbound command - should be bound or removed. +(defun rst-join-paragraph () + "Join lines in current paragraph into one line, removing end-of-lines." + (interactive) + (let ((fill-column 65000)) ; Some big number. + (call-interactively #'fill-paragraph))) + +;; FIXME: Unbound command - should be bound or removed. +(defun rst-force-fill-paragraph () + "Fill paragraph at point, first joining the paragraph's lines into one. +This is useful for filling list item paragraphs." + (interactive) + (rst-join-paragraph) + (fill-paragraph nil)) + + +;; FIXME: Unbound command - should be bound or removed. +;; Generic character repeater function. +;; For sections, better to use the specialized function above, but this can +;; 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. + +If USE-NEXT, use the next line rather than the preceding line. + +If the current line is longer than the desired length, shave the characters off +the current line to fit the desired length. + +As an added convenience, if the command is repeated immediately, the alternative +column is used (fill-column vs. end of previous/next line)." + (interactive "P") + (let* ((curcol (current-column)) + (curline (+ (count-lines (point-min) (point)) + (if (zerop curcol) 1 0))) + (lbp (line-beginning-position 0)) + (prevcol (if (and (= curline 1) (not use-next)) + fill-column + (save-excursion + (forward-line (if use-next 1 -1)) + (end-of-line) + (skip-chars-backward " \t" lbp) + (let ((cc (current-column))) + (if (zerop cc) fill-column cc))))) + (rightmost-column + (cond ((equal last-command 'rst-repeat-last-character) + (if (= curcol fill-column) prevcol fill-column)) + (t (save-excursion + (if (zerop prevcol) fill-column prevcol)))))) + (end-of-line) + (if (> (current-column) rightmost-column) + ;; Shave characters off the end. + (delete-region (- (point) + (- (current-column) rightmost-column)) + (point)) + ;; Fill with last characters. + (insert-char (preceding-char) + (- rightmost-column (current-column)))))) + + + +;; LocalWords: docutils http sourceforge rst html wp svn svnroot txt reST regex +;; LocalWords: regexes alist seq alt grp keymap abbrev overline overlines toc +;; LocalWords: XML PNT propertized init referenceable + +(provide 'rst) + +;; Local Variables: +;; sentence-end-double-space: t +;; End: + +;;; rst.el ends here diff --git a/init.el b/init.el index e58499f7..a8b0f0ac 100644 --- a/init.el +++ b/init.el @@ -1,6 +1,10 @@ +;; -*- coding: utf-8 -*- (add-to-list 'custom-theme-load-path (expand-file-name "~/.emacs.d/bundle/nord-theme/")) (load-theme 'nord t) -(menu-bar-mode -1) + +(add-to-list 'load-path (expand-file-name "~/.emacs.d/bundle")) +(require 'rst) + (custom-set-variables ;; custom-set-variables was added by Custom. ;; If you edit it by hand, you could mess it up, so be careful. @@ -15,3 +19,5 @@ ;; Your init file should contain only one such instance. ;; If there is more than one, they won't work right. ) + +(menu-bar-mode -1)