aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Merten2012-05-07 21:51:25 +0200
committerStefan Merten2012-05-07 21:51:25 +0200
commitd13c8be67c41a533dfc5d8ebda8a263274f21b83 (patch)
treed7e12ec0fc65e3a39f095438b77344bf1ec652c7
parentf0809a9d058443cd92f7145a70c25ce10d285971 (diff)
downloademacs-d13c8be67c41a533dfc5d8ebda8a263274f21b83.tar.gz
emacs-d13c8be67c41a533dfc5d8ebda8a263274f21b83.zip
2012-05-05 Stefan Merten <smerten@oekonux.de>
* rst.el: Major merge with upstream development up to Docutils SVN r7399 / rst.el V1.2.1. Clarified maintainership and authors. (rst-extract-version, rst-cvs-header, rst-cvs-rev) (rst-cvs-timestamp, rst-svn-rev, rst-svn-timestamp) (rst-official-version, rst-official-cvs-rev, rst-version) (rst-package-emacs-version-alist): New functions and variables for version information. (rst-bullets, rst-uri-schemes, rst-adornment-chars) (rst-max-inline-length, rst-re-alist-def, rst-re-alist) (rst-mode-syntax-table, rst-mode): New and corrected functions and variables representing reStructuredText features. (rst-re): New function for reStructuredText regexes. Used in many places. (rst-deprecated-keys, rst-call-deprecated, rst-define-key) (rst-mode-map): Rebound keys. (rst-mode-lazy, rst-font-lock-keywords) (rst-font-lock-extend-region) (rst-font-lock-extend-region-internal) (rst-font-lock-extend-region-extend) (rst-font-lock-find-unindented-line-limit) (rst-font-lock-find-unindented-line-match) (rst-adornment-level, rst-font-lock-adornment-level) (rst-font-lock-adornment-match) (rst-font-lock-handle-adornment-pre-match-form) (rst-font-lock-handle-adornment-matcher): Major revision of font-locking. Integrated with other code. `jit-lock-mode' is used now. (rst-preferred-adornments, rst-adjust-hook) (rst-new-adornment-down, rst-preferred-bullets) (rst-preferred-bullets, rst-indent, rst-indent-width) (rst-indent-field, rst-indent-literal-normal) (rst-indent-literal-minimized, rst-indent-comment): Changed, extended and improved customization. (rst-line-homogeneous-p, rst-line-homogeneous-nodent-p) (rst-normalize-cursor-position, rst-get-decoration) (rst-straighten-deco-spacing, rst-re-bullets, rst-re-items) (rst-rstrip, rst-toc-insert-find-delete-contents) (rst-shift-fill-region, rst-compute-bullet-tabs) (rst-debug-print-tabs, rst-debug-mark-found) (rst-shift-region-guts, rst-shift-region-right) (rst-shift-region-left, rst-use-char-classes) (rst-font-lock-keywords-function) (rst-font-lock-indentation-point) (rst-font-lock-find-unindented-line-begin) (rst-font-lock-find-unindented-line-end) (rst-font-lock-find-unindented-line) (rst-font-lock-adornment-point, rst-font-lock-level) (rst-adornment-level-alist): Removed functions and variables. (rst-compare-adornments, rst-get-adornment-match) (rst-suggest-new-adornment, rst-get-adornments-around) (rst-adornment-complete-p, rst-get-next-adornment) (rst-adjust-adornment, rst-display-adornments-hierarchy) (rst-straighten-adornments): Standardized function names to use "adornment" instead of "decoration". Corrected callers. Similar standardizing happened in many places. (rst-update-section, rst-adjust, rst-promote-region) (rst-enumerate-region, rst-bullet-list-region) (rst-repeat-last-character): Corrected use of `interactive'. (rst-classify-adornment, rst-find-all-adornments) (rst-get-hierarchy, rst-adjust-adornment, rst-toc-update) (rst-find-leftmost-column, rst-repeat-last-character): Refactored functions. (rst-find-title-line, rst-reset-section-caches) (rst-get-adornments-around, rst-adjust-adornment-work) (rst-arabic-to-roman, rst-roman-to-arabic) (rst-insert-list-pos, rst-insert-list-new-item) (rst-insert-list-continue, rst-insert-list, rst-forward-line): New functions. (rst-all-sections, rst-section-hierarchy) (rst-arabic-to-roman, rst-initial-enums, rst-initial-items): New variables. (rst-toc-return-wincfg, rst-toc-quit-window): Using window configuration instead of only buffer. Changed where necessary. (rst-line-tabs, rst-compute-tabs, rst-indent-line) (rst-shift-region, rst-adaptive-fill): New functions for indentation and filling. (rst-comment-line-break, rst-comment-indent) (rst-comment-insert-comment, rst-comment-region) (rst-uncomment-region): New functions for handling comments. (rst-compile): Shell arguments are quoted. (rst-compile-pdf-preview, rst-compile-slides-preview): Temporary files are deleted after use.
-rw-r--r--etc/NEWS32
-rw-r--r--lisp/textmodes/rst.el3849
2 files changed, 2252 insertions, 1629 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 6b59601fd81..baa39db0cb6 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -82,6 +82,38 @@ character when doing minibuffer filename prompts.
82 82
83* Changes in Specialized Modes and Packages in Emacs 24.2 83* Changes in Specialized Modes and Packages in Emacs 24.2
84 84
85** reStructuredText mode
86
87*** Major merge with upstream development.
88
89*** Nearly all keys are rebound making room for more keys and comply
90better to usage in other modes. Bindings are described with C-c C-h.
91
92*** Major revision of indentation. Now works very similar to other
93modes. TAB is your friend.
94
95*** Major revision of filling. Works fine with most of
96reStructuredText syntax. Auto-filling is also supported.
97
98*** Major revision of comment handling.
99
100*** Major revision of fontification. Now works with `jit-lock-mode'.
101Thanks to Stefan Monnier for help.
102
103*** reStructuredText syntax is covered more closely in many cases.
104Among other things this improves the experience for Sphinx users.
105
106*** `rst-insert-list' inserts new list or continues existing lists.
107Based on code by Wei-Wei Guo.
108
109*** Customization is extended, corrected and improved.
110
111*** Negative prefix argument always works for `rst-adjust'.
112
113*** Window configuration is reset after displaying TOC.
114
115*** There is a package version in `rst-version'
116
85** New `derived-mode' filter for Ibuffer, bound to `/ M'. 117** New `derived-mode' filter for Ibuffer, bound to `/ M'.
86`/ m' is now bound to filter by used-mode, which used to be bound to `/ M'. 118`/ m' is now bound to filter by used-mode, which used to be bound to `/ M'.
87 119
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 1b1860c833d..a9f280be1db 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -2,9 +2,10 @@
2 2
3;; Copyright (C) 2003-2012 Free Software Foundation, Inc. 3;; Copyright (C) 2003-2012 Free Software Foundation, Inc.
4 4
5;; Authors: Martin Blais <blais@furius.ca>, 5;; Maintainer: Stefan Merten <smerten@oekonux.de>
6;; Stefan Merten <smerten@oekonux.de>, 6;; Author: Martin Blais <blais@furius.ca>,
7;; David Goodger <goodger@python.org> 7;; David Goodger <goodger@python.org>,
8;; Wei-Wei Guo <wwguocn@gmail.com>
8 9
9;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
10 11
@@ -23,19 +24,23 @@
23 24
24;;; Commentary: 25;;; Commentary:
25 26
26;; This package provides major mode rst-mode, which supports documents marked up 27;; This package provides major mode rst-mode, which supports documents marked
27;; using the reStructuredText format. Support includes font locking as well as 28;; up using the reStructuredText format. Support includes font locking as well
28;; some convenience functions for editing. It does this by defining a Emacs 29;; as a lot of convenience functions for editing. It does this by defining a
29;; major mode: rst-mode (ReST). This mode is derived from text-mode (and 30;; Emacs major mode: rst-mode (ReST). This mode is derived from text-mode. This
30;; inherits much of it). This package also contains: 31;; package also contains:
31;; 32;;
32;; - Functions to automatically adjust and cycle the section underline 33;; - Functions to automatically adjust and cycle the section underline
33;; decorations; 34;; adornments;
34;; - A mode that displays the table of contents and allows you to jump anywhere 35;; - A mode that displays the table of contents and allows you to jump anywhere
35;; from it; 36;; from it;
36;; - Functions to insert and automatically update a TOC in your source 37;; - Functions to insert and automatically update a TOC in your source
37;; document; 38;; document;
38;; - Font-lock highlighting of notable reStructuredText structures; 39;; - Function to insert list, processing item bullets and enumerations
40;; automatically;
41;; - Font-lock highlighting of most reStructuredText structures;
42;; - Indentation and filling according to reStructuredText syntax;
43;; - Cursor movement according to reStructuredText syntax;
39;; - Some other convenience functions. 44;; - Some other convenience functions.
40;; 45;;
41;; See the accompanying document in the docutils documentation about 46;; See the accompanying document in the docutils documentation about
@@ -49,17 +54,8 @@
49;; 54;;
50;; 55;;
51;; There are a number of convenient keybindings provided by rst-mode. 56;; There are a number of convenient keybindings provided by rst-mode.
52;; The main one is
53;;
54;; C-c C-a (also C-=): rst-adjust
55;;
56;; Updates or rotates the section title around point or promotes/demotes the
57;; decorations within the region (see full details below). Note that C-= is a
58;; good binding, since it allows you to specify a negative arg easily with C--
59;; C-= (easy to type), as well as ordinary prefix arg with C-u C-=.
60;;
61;; For more on bindings, see rst-mode-map below. There are also many variables 57;; For more on bindings, see rst-mode-map below. There are also many variables
62;; that can be customized, look for defcustom and defvar in this file. 58;; that can be customized, look for defcustom in this file.
63;; 59;;
64;; If you use the table-of-contents feature, you may want to add a hook to 60;; If you use the table-of-contents feature, you may want to add a hook to
65;; update the TOC automatically everytime you adjust a section title:: 61;; update the TOC automatically everytime you adjust a section title::
@@ -71,52 +67,16 @@
71;; 67;;
72;; (setq font-lock-global-modes '(not rst-mode ...)) 68;; (setq font-lock-global-modes '(not rst-mode ...))
73;; 69;;
74
75
76;; CUSTOMIZATION
77;;
78;; rst
79;; ---
80;; This group contains some general customizable features.
81;;
82;; The group is contained in the wp group.
83;;
84;; rst-faces
85;; ---------
86;; This group contains all necessary for customizing fonts. The default
87;; settings use standard font-lock-*-face's so if you set these to your
88;; liking they are probably good in rst-mode also.
89;;
90;; The group is contained in the faces group as well as in the rst group.
91;; 70;;
92;; rst-faces-defaults
93;; ------------------
94;; This group contains all necessary for customizing the default fonts used for
95;; section title faces.
96;; 71;;
97;; The general idea for section title faces is to have a non-default background 72;; Customization is done by customizable variables contained in customization
98;; but do not change the background. The section level is shown by the 73;; group "rst" and subgroups. Group "rst" is contained in the "wp" group.
99;; lightness of the background color. If you like this general idea of
100;; generating faces for section titles but do not like the details this group
101;; is the point where you can customize the details. If you do not like the
102;; general idea, however, you should customize the faces used in
103;; rst-adornment-faces-alist.
104;; 74;;
105;; Note: If you are using a dark background please make sure the variable
106;; frame-background-mode is set to the symbol dark. This triggers
107;; some default values which are probably right for you.
108;;
109;; The group is contained in the rst-faces group.
110;;
111;; All customizable features have a comment explaining their meaning.
112;; Refer to the customization of your Emacs (try ``M-x customize``).
113
114 75
115;;; DOWNLOAD 76;;; DOWNLOAD
116 77
117;; The latest version of this file lies in the docutils source code repository: 78;; The latest release of this file lies in the docutils source code repository:
118;; http://svn.berlios.de/svnroot/repos/docutils/trunk/docutils/tools/editors/emacs/rst.el 79;; http://docutils.svn.sourceforge.net/svnroot/docutils/trunk/docutils/tools/editors/emacs/rst.el
119
120 80
121;;; INSTALLATION 81;;; INSTALLATION
122 82
@@ -140,62 +100,81 @@
140;; ("\\.rest$" . rst-mode)) auto-mode-alist)) 100;; ("\\.rest$" . rst-mode)) auto-mode-alist))
141;; 101;;
142 102
143;;; BUGS 103;;; Code:
144
145;; - rst-enumeration-region: Select a single paragraph, with the top at one
146;; blank line before the beginning, and it will fail.
147;; - The active region goes away when we shift it left or right, and this
148;; prevents us from refilling it automatically when shifting many times.
149;; - The suggested decorations when adjusting should not have to cycle
150;; below one below the last section decoration level preceding the
151;; cursor. We need to fix that.
152
153;;; TODO LIST
154
155;; rst-toc-insert features
156;; ------------------------
157;; - rst-toc-insert: We should parse the contents:: options to figure out how
158;; deep to render the inserted TOC.
159;; - On load, detect any existing TOCs and set the properties for links.
160;; - TOC insertion should have an option to add empty lines.
161;; - TOC insertion should deal with multiple lines.
162;; - There is a bug on redo after undo of adjust when rst-adjust-hook uses the
163;; automatic toc update. The cursor ends up in the TOC and this is
164;; annoying. Gotta fix that.
165;; - numbering: automatically detect if we have a section-numbering directive in
166;; the corresponding section, to render the toc.
167;;
168;; bulleted and enumerated list items
169;; ----------------------------------
170;; - We need to provide way to rebullet bulleted lists, and that would include
171;; automatic enumeration as well.
172;;
173;; Other
174;; -----
175;; - It would be nice to differentiate between text files using
176;; reStructuredText_ and other general text files. If we had a
177;; function to automatically guess whether a .txt file is following the
178;; reStructuredText_ conventions, we could trigger rst-mode without
179;; having to hard-code this in every text file, nor forcing the user to
180;; add a local mode variable at the top of the file.
181;; We could perform this guessing by searching for a valid decoration
182;; at the top of the document or searching for reStructuredText_
183;; directives further on.
184;;
185;; - We should support imenu in our major mode, with the menu filled with the
186;; section titles (this should be really easy).
187;;
188;; - We should rename "adornment" to "decoration" or vice-versa in this
189;; document (Stefan's code ("adornment") vs Martin ("decoration")), maybe some
190;; functions even overlap.
191;;
192;; - We need to automatically recenter on rst-forward-section movement commands.
193 104
105(require 'cl)
194 106
195;;; HISTORY 107;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
196;; 108;; Versions
109
110(defun rst-extract-version (delim-re head-re re tail-re var &optional default)
111 "Return the version matching RE after regex DELIM-RE and HEAD-RE
112and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match"
113 (if (string-match
114 (concat delim-re head-re "\\(" re "\\)" tail-re delim-re)
115 var)
116 (match-string 1 var)
117 default))
118
119;; Use CVSHeader to really get information from CVS and not other version
120;; control systems
121(defconst rst-cvs-header
122 "$CVSHeader: sm/rst_el/rst.el,v 1.257 2012-04-29 15:01:17 stefan Exp $")
123(defconst rst-cvs-rev
124 (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+"
125 " .*" rst-cvs-header "0.0")
126 "The CVS revision of this file. CVS revision is the development revision.")
127(defconst rst-cvs-timestamp
128 (rst-extract-version "\\$" "CVSHeader: \\S + \\S + "
129 "[0-9]+-[0-9]+-[0-9]+ [0-9]+:[0-9]+:[0-9]+" " .*"
130 rst-cvs-header "1970-01-01 00:00:00")
131 "The CVS timestamp of this file.")
132
133;; Use LastChanged... to really get information from SVN
134(defconst rst-svn-rev
135 (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " "
136 "$LastChangedRevision: 7399 $")
137 "The SVN revision of this file.
138SVN revision is the upstream (docutils) revision.")
139(defconst rst-svn-timestamp
140 (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " "
141 "$LastChangedDate: 2012-04-29 17:01:05 +0200 (Sun, 29 Apr 2012) $")
142 "The SVN timestamp of this file.")
143
144;; Maintained by the release process
145(defconst rst-official-version
146 (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
147 "%OfficialVersion: 1.2.1 %")
148 "Official version of the package.")
149(defconst rst-official-cvs-rev
150 (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " "
151 "%Revision: 1.256 %")
152 "CVS revision of this file in the official version.")
153
154(defconst rst-version
155 (if (equal rst-official-cvs-rev rst-cvs-rev)
156 rst-official-version
157 (format "%s (development %s [%s])" rst-official-version
158 rst-cvs-rev rst-cvs-timestamp))
159 "The version string.
160Starts with the current official version. For developer versions
161in parentheses follows the development revision and the timestamp.")
162
163(defconst rst-package-emacs-version-alist
164 '(("1.0.0" . "24.0")
165 ("1.1.0" . "24.0")
166 ("1.2.0" . "24.0")
167 ("1.2.1" . "24.0")))
168
169(unless (assoc rst-official-version rst-package-emacs-version-alist)
170 (error "Version %s not listed in `rst-package-emacs-version-alist'"
171 rst-version))
172
173(add-to-list 'customize-package-emacs-version-alist
174 (cons 'ReST rst-package-emacs-version-alist))
197 175
198;;; Code: 176;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
177;; Initialize customization
199 178
200 179
201(defgroup rst nil "Support for reStructuredText documents." 180(defgroup rst nil "Support for reStructuredText documents."
@@ -203,102 +182,460 @@
203 :version "23.1" 182 :version "23.1"
204 :link '(url-link "http://docutils.sourceforge.net/rst.html")) 183 :link '(url-link "http://docutils.sourceforge.net/rst.html"))
205 184
206
207
208 185
209;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 186;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
210;; Define some generic support functions. 187;; Facilities for regular expressions used everywhere
211 188
212(eval-when-compile (require 'cl)) ;; We need this for destructuring-bind below. 189;; The trailing numbers in the names give the number of referenceable regex
213 190;; groups contained in the regex
214 191
215;; From Emacs-22 192;; Used to be customizable but really is not customizable but fixed by the reST
216(unless (fboundp 'line-number-at-pos) 193;; syntax
217 (defun line-number-at-pos (&optional pos) 194(defconst rst-bullets
218 "Return (narrowed) buffer line number at position POS. 195 ;; Sorted so they can form a character class when concatenated
219 If POS is nil, use current buffer location." 196 '(?- ?* ?+ ?\u2022 ?\u2023 ?\u2043)
220 (let ((opoint (or pos (point))) start) 197 "List of all possible bullet characters for bulleted lists.")
221 (save-excursion 198
222 (goto-char (point-min)) 199(defconst rst-uri-schemes
223 (setq start (point)) 200 '("acap" "cid" "data" "dav" "fax" "file" "ftp" "gopher" "http" "https" "imap"
224 (goto-char opoint) 201 "ldap" "mailto" "mid" "modem" "news" "nfs" "nntp" "pop" "prospero" "rtsp"
225 (forward-line 0) 202 "service" "sip" "tel" "telnet" "tip" "urn" "vemmi" "wais")
226 (1+ (count-lines start (point)))))) ) 203 "Supported URI schemes.")
227 204
205(defconst rst-adornment-chars
206 ;; Sorted so they can form a character class when concatenated
207 '(?\]
208 ?! ?\" ?# ?$ ?% ?& ?' ?\( ?\) ?* ?+ ?, ?. ?/ ?: ?\; ?< ?= ?> ?? ?@ ?\[ ?\\
209 ?^ ?_ ?` ?{ ?| ?} ?~
210 ?-)
211 "Characters which may be used in adornments for sections and transitions.")
212
213(defconst rst-max-inline-length
214 1000
215 "Maximum length of inline markup to recognize.")
216
217(defconst rst-re-alist-def
218 ;; `*-beg' matches * at the beginning of a line
219 ;; `*-end' matches * at the end of a line
220 ;; `*-prt' matches a part of *
221 ;; `*-tag' matches *
222 ;; `*-sta' matches the start of * which may be followed by respective content
223 ;; `*-pfx' matches the delimiter left of *
224 ;; `*-sfx' matches the delimiter right of *
225 ;; `*-hlp' helper for *
226 ;;
227 ;; A trailing number says how many referenceable groups are contained.
228 `(
229
230 ;; Horizontal white space (`hws')
231 (hws-prt "[\t ]")
232 (hws-tag hws-prt "*") ; Optional sequence of horizontal white space
233 (hws-sta hws-prt "+") ; Mandatory sequence of horizontal white space
234
235 ;; Lines (`lin')
236 (lin-beg "^" hws-tag) ; Beginning of a possibly indented line
237 (lin-end hws-tag "$") ; End of a line with optional trailing white space
238 (linemp-tag "^" hws-tag "$") ; Empty line with optional white space
239
240 ;; Various tags and parts
241 (ell-tag "\\.\\.\\.") ; Ellipsis
242 (bul-tag ,(concat "[" rst-bullets "]")) ; A bullet
243 (ltr-tag "[a-zA-Z]") ; A letter enumerator tag
244 (num-prt "[0-9]") ; A number enumerator part
245 (num-tag num-prt "+") ; A number enumerator tag
246 (rom-prt "[IVXLCDMivxlcdm]") ; A roman enumerator part
247 (rom-tag rom-prt "+") ; A roman enumerator tag
248 (aut-tag "#") ; An automatic enumerator tag
249 (dcl-tag "::") ; Double colon
250
251 ;; Block lead in (`bli')
252 (bli-sfx (:alt hws-sta "$")) ; Suffix of a block lead-in with *optional*
253 ; immediate content
254
255 ;; Various starts
256 (bul-sta bul-tag bli-sfx) ; Start of a bulleted item
257
258 ;; Explicit markup tag (`exm')
259 (exm-tag "\\.\\.")
260 (exm-sta exm-tag hws-sta)
261 (exm-beg lin-beg exm-sta)
262
263 ;; Counters in enumerations (`cnt')
264 (cntany-tag (:alt ltr-tag num-tag rom-tag aut-tag)) ; An arbitrary counter
265 (cntexp-tag (:alt ltr-tag num-tag rom-tag)) ; An arbitrary explicit counter
266
267 ;; Enumerator (`enm')
268 (enmany-tag (:alt
269 (:seq cntany-tag "\\.")
270 (:seq "(?" cntany-tag ")"))) ; An arbitrary enumerator
271 (enmexp-tag (:alt
272 (:seq cntexp-tag "\\.")
273 (:seq "(?" cntexp-tag ")"))) ; An arbitrary explicit
274 ; enumerator
275 (enmaut-tag (:alt
276 (:seq aut-tag "\\.")
277 (:seq "(?" aut-tag ")"))) ; An automatic enumerator
278 (enmany-sta enmany-tag bli-sfx) ; An arbitrary enumerator start
279 (enmexp-sta enmexp-tag bli-sfx) ; An arbitrary explicit enumerator start
280 (enmexp-beg lin-beg enmexp-sta) ; An arbitrary explicit enumerator start
281 ; at the beginning of a line
282
283 ;; Items may be enumerated or bulleted (`itm')
284 (itmany-tag (:alt enmany-tag bul-tag)) ; An arbitrary item tag
285 (itmany-sta-1 (:grp itmany-tag) bli-sfx) ; An arbitrary item start, group
286 ; is the item tag
287 (itmany-beg-1 lin-beg itmany-sta-1) ; An arbitrary item start at the
288 ; beginning of a line, group is the
289 ; item tag
290
291 ;; Inline markup (`ilm')
292 (ilm-pfx (:alt "^" hws-prt "[-'\"([{<\u2018\u201c\u00ab\u2019/:]"))
293 (ilm-sfx (:alt "$" hws-prt "[]-'\")}>\u2019\u201d\u00bb/:.,;!?\\]"))
294
295 ;; Inline markup content (`ilc')
296 (ilcsgl-tag "\\S ") ; A single non-white character
297 (ilcast-prt (:alt "[^*\\]" "\\\\.")) ; Part of non-asterisk content
298 (ilcbkq-prt (:alt "[^`\\]" "\\\\.")) ; Part of non-backquote content
299 (ilcbkqdef-prt (:alt "[^`\\\n]" "\\\\.")) ; Part of non-backquote
300 ; definition
301 (ilcbar-prt (:alt "[^|\\]" "\\\\.")) ; Part of non-vertical-bar content
302 (ilcbardef-prt (:alt "[^|\\\n]" "\\\\.")) ; Part of non-vertical-bar
303 ; definition
304 (ilcast-sfx "[^\t *\\]") ; Suffix of non-asterisk content
305 (ilcbkq-sfx "[^\t `\\]") ; Suffix of non-backquote content
306 (ilcbar-sfx "[^\t |\\]") ; Suffix of non-vertical-bar content
307 (ilcrep-hlp ,(format "\\{0,%d\\}" rst-max-inline-length)) ; Repeat count
308 (ilcast-tag (:alt ilcsgl-tag
309 (:seq ilcsgl-tag
310 ilcast-prt ilcrep-hlp
311 ilcast-sfx))) ; Non-asterisk content
312 (ilcbkq-tag (:alt ilcsgl-tag
313 (:seq ilcsgl-tag
314 ilcbkq-prt ilcrep-hlp
315 ilcbkq-sfx))) ; Non-backquote content
316 (ilcbkqdef-tag (:alt ilcsgl-tag
317 (:seq ilcsgl-tag
318 ilcbkqdef-prt ilcrep-hlp
319 ilcbkq-sfx))) ; Non-backquote definition
320 (ilcbar-tag (:alt ilcsgl-tag
321 (:seq ilcsgl-tag
322 ilcbar-prt ilcrep-hlp
323 ilcbar-sfx))) ; Non-vertical-bar content
324 (ilcbardef-tag (:alt ilcsgl-tag
325 (:seq ilcsgl-tag
326 ilcbardef-prt ilcrep-hlp
327 ilcbar-sfx))) ; Non-vertical-bar definition
328
329 ;; Fields (`fld')
330 (fldnam-prt (:alt "[^:\n]" "\\\\:")) ; Part of a field name
331 (fldnam-tag fldnam-prt "+") ; A field name
332 (fld-tag ":" fldnam-tag ":") ; A field marker
333
334 ;; Options (`opt')
335 (optsta-tag (:alt "[-+/]" "--")) ; Start of an option
336 (optnam-tag "\\sw" (:alt "-" "\\sw") "*") ; Name of an option
337 (optarg-tag (:shy "[ =]\\S +")) ; Option argument
338 (optsep-tag (:shy "," hws-prt)) ; Separator between options
339 (opt-tag (:shy optsta-tag optnam-tag optarg-tag "?")) ; A complete option
340
341 ;; Footnotes and citations (`fnc')
342 (fncnam-prt "[^\]\n]") ; Part of a footnote or citation name
343 (fncnam-tag fncnam-prt "+") ; A footnote or citation name
344 (fnc-tag "\\[" fncnam-tag "]") ; A complete footnote or citation tag
345 (fncdef-tag-2 (:grp exm-sta)
346 (:grp fnc-tag)) ; A complete footnote or citation definition
347 ; tag; first group is the explicit markup
348 ; start, second group is the footnote /
349 ; citation tag
350 (fnc-sta-2 fncdef-tag-2 bli-sfx) ; Start of a footnote or citation
351 ; definition; first group is the explicit
352 ; markup start, second group is the
353 ; footnote / citation tag
354
355 ;; Substitutions (`sub')
356 (sub-tag "|" ilcbar-tag "|") ; A complete substitution tag
357 (subdef-tag "|" ilcbardef-tag "|") ; A complete substitution definition
358 ; tag
359
360 ;; Symbol (`sym')
361 (sym-tag (:shy "\\sw+" (:shy "\\s_\\sw+") "*"))
362
363 ;; URIs (`uri')
364 (uri-tag (:alt ,@rst-uri-schemes))
365
366 ;; Adornment (`ado')
367 (ado-prt "[" ,(concat rst-adornment-chars) "]")
368 (adorep3-hlp "\\{3,\\}") ; There must be at least 3 characters because
369 ; otherwise explicit markup start would be
370 ; recognized
371 (adorep2-hlp "\\{2,\\}") ; As `adorep3-hlp' but when the first of three
372 ; characters is matched differently
373 (ado-tag-1-1 (:grp ado-prt)
374 "\\1" adorep2-hlp) ; A complete adornment, group is the first
375 ; adornment character and MUST be the FIRST
376 ; group in the whole expression
377 (ado-tag-1-2 (:grp ado-prt)
378 "\\2" adorep2-hlp) ; A complete adornment, group is the first
379 ; adornment character and MUST be the
380 ; SECOND group in the whole expression
381 (ado-beg-2-1 "^" (:grp ado-tag-1-2)
382 lin-end) ; A complete adornment line; first group is the whole
383 ; adornment and MUST be the FIRST group in the whole
384 ; expression; second group is the first adornment
385 ; character
386
387 ;; Titles (`ttl')
388 (ttl-tag "\\S *\\w\\S *") ; A title text
389 (ttl-beg lin-beg ttl-tag) ; A title text at the beginning of a line
390
391 ;; Directives and substitution definitions (`dir')
392 (dir-tag-3 (:grp exm-sta)
393 (:grp (:shy subdef-tag hws-sta) "?")
394 (:grp sym-tag dcl-tag)) ; A directive or substitution definition
395 ; tag; first group is explicit markup
396 ; start, second group is a possibly
397 ; empty substitution tag, third group is
398 ; the directive tag including the double
399 ; colon
400 (dir-sta-3 dir-tag-3 bli-sfx) ; Start of a directive or substitution
401 ; definition; groups are as in dir-tag-3
402
403 ;; Literal block (`lit')
404 (lit-sta-2 (:grp (:alt "[^.\n]" "\\.[^.\n]") ".*") "?"
405 (:grp dcl-tag) "$") ; Start of a literal block; first group is
406 ; any text before the double colon tag which
407 ; may not exist, second group is the double
408 ; colon tag
409
410 ;; Comments (`cmt')
411 (cmt-sta-1 (:grp exm-sta) "[^\[|_\n]"
412 (:alt "[^:\n]" (:seq ":" (:alt "[^:\n]" "$")))
413 "*$") ; Start of a comment block; first group is explicit markup
414 ; start
415
416 ;; Paragraphs (`par')
417 (par-tag- (:alt itmany-tag fld-tag opt-tag fncdef-tag-2 dir-tag-3 exm-tag)
418 ) ; Tag at the beginning of a paragraph; there may be groups in
419 ; certain cases
420 )
421 "Definition alist of relevant regexes.
422Each entry consists of the symbol naming the regex and an
423argument list for `rst-re'.")
424
425;; FIXME: Use `sregex` or `rx` instead of re-inventing the wheel
426(defun rst-re (&rest args)
427 "Interpret ARGS as regular expressions and return a regex string.
428Each element of ARGS may be one of the following:
429
430A string which is inserted unchanged.
431
432A character which is resolved to a quoted regex.
433
434A symbol which is resolved to a string using `rst-re-alist-def'.
435
436A list with a keyword in the car. Each element of the cdr of such
437a list is recursively interpreted as ARGS. The results of this
438interpretation are concatenated according to the keyword.
439
440For the keyword `:seq' the results are simply concatenated.
441
442For the keyword `:shy' the results are concatenated and
443surrounded by a shy-group (\"\\(?:...\\)\").
444
445For the keyword `:alt' the results form an alternative (\"\\|\")
446which is shy-grouped (\"\\(?:...\\)\").
447
448For the keyword `:grp' the results are concatenated and form a
449referencable grouped (\"\\(...\\)\").
450
451After interpretation of ARGS the results are concatenated as for
452`:seq'.
453"
454 (apply 'concat
455 (mapcar
456 (lambda (re)
457 (cond
458 ((stringp re)
459 re)
460 ((symbolp re)
461 (cadr (assoc re rst-re-alist)))
462 ((char-valid-p re)
463 (regexp-quote (char-to-string re)))
464 ((listp re)
465 (let ((nested
466 (mapcar (lambda (elt)
467 (rst-re elt))
468 (cdr re))))
469 (cond
470 ((eq (car re) :seq)
471 (mapconcat 'identity nested ""))
472 ((eq (car re) :shy)
473 (concat "\\(?:" (mapconcat 'identity nested "") "\\)"))
474 ((eq (car re) :grp)
475 (concat "\\(" (mapconcat 'identity nested "") "\\)"))
476 ((eq (car re) :alt)
477 (concat "\\(?:" (mapconcat 'identity nested "\\|") "\\)"))
478 (t
479 (error "Unknown list car: %s" (car re))))))
480 (t
481 (error "Unknown object type for building regex: %s" re))))
482 args)))
483
484(defconst rst-re-alist
485 ;; Shadow global value we are just defining so we can construct it step by
486 ;; step
487 (let (rst-re-alist)
488 (dolist (re rst-re-alist-def)
489 (setq rst-re-alist
490 (nconc rst-re-alist
491 (list (list (car re) (apply 'rst-re (cdr re)))))))
492 rst-re-alist)
493 "Alist mapping symbols from `rst-re-alist-def' to regex strings.")
228 494
229 495
230;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 496;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
231;; Mode definition. 497;; Mode definition.
232 498
499(defvar rst-deprecated-keys nil
500 "Alist mapping deprecated keys to the new key to use and the definition.")
501
502(require 'edmacro)
503
504(defun rst-call-deprecated ()
505 (interactive)
506 (let* ((dep-key (this-command-keys-vector))
507 (dep-key-s (format-kbd-macro dep-key))
508 (fnd (assoc dep-key rst-deprecated-keys)))
509 (if (not fnd)
510 ;; Exact key sequence not found. Maybe a deprecated key sequence has
511 ;; been followed by another key.
512 (let* ((dep-key-pfx (butlast (append dep-key nil) 1))
513 (dep-key-def (vconcat dep-key-pfx '(t)))
514 (fnd-def (assoc dep-key-def rst-deprecated-keys)))
515 (if (not fnd-def)
516 (error "Unknown deprecated key sequence %s" dep-key-s)
517 ;; Don't execute the command in this case
518 (message "[Deprecated use of key %s; use key %s instead]"
519 (format-kbd-macro dep-key-pfx)
520 (format-kbd-macro (second fnd-def)))))
521 (message "[Deprecated use of key %s; use key %s instead]"
522 dep-key-s (format-kbd-macro (second fnd)))
523 (call-interactively (third fnd)))))
524
525(defun rst-define-key (keymap key def &rest deprecated)
526 "Bind like `define-key' using DEPRECATED as deprecated key definitions.
527DEPRECATED key definitions should be in vector notation. These
528are defined as well but give an additional message."
529 (define-key keymap key def)
530 (dolist (dep-key deprecated)
531 (push (list dep-key key def) rst-deprecated-keys)
532 (define-key keymap dep-key 'rst-call-deprecated)))
533
233;; Key bindings. 534;; Key bindings.
234(defvar rst-mode-map 535(defvar rst-mode-map
235 (let ((map (make-sparse-keymap))) 536 (let ((map (make-sparse-keymap)))
236 537
538 ;; \C-c is the general keymap
539 (rst-define-key map [?\C-c ?\C-h] 'describe-prefix-bindings)
540
237 ;; 541 ;;
238 ;; Section Decorations. 542 ;; Section Adornments.
239 ;; 543 ;;
240 ;; The adjustment function that decorates or rotates a section title. 544 ;; The adjustment function that adorns or rotates a section title.
241 (define-key map [(control c) (control a)] 'rst-adjust) 545 (rst-define-key map [?\C-c ?\C-=] 'rst-adjust [?\C-c ?\C-a t])
242 (define-key map [(control c) (control ?=)] 'rst-adjust) 546 (rst-define-key map [?\C-=] 'rst-adjust) ; (Does not work on the Mac OSX.)
243 (define-key map [(control ?=)] 'rst-adjust) ;; (Does not work on the Mac OSX.) 547
244 ;; Display the hierarchy of decorations implied by the current document contents. 548 ;; \C-c \C-a is the keymap for adornments
245 (define-key map [(control c) (control h)] 'rst-display-decorations-hierarchy) 549 (rst-define-key map [?\C-c ?\C-a ?\C-h] 'describe-prefix-bindings)
246 ;; Homogenize the decorations in the document. 550 ;; Display the hierarchy of adornments implied by the current document contents.
247 (define-key map [(control c) (control s)] 'rst-straighten-decorations) 551 (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-adornments-hierarchy)
248;; (define-key map [(control c) (control s)] 'rst-straighten-deco-spacing) 552 ;; Homogenize the adornments in the document.
553 (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-adornments
554 [?\C-c ?\C-s])
249 555
250 ;; 556 ;;
251 ;; Section Movement and Selection. 557 ;; Section Movement and Selection.
252 ;; 558 ;;
253 ;; Mark the subsection where the cursor is. 559 ;; Mark the subsection where the cursor is.
254 (define-key map [(control c) (control m)] 'rst-mark-section) 560 (rst-define-key map [?\C-\M-h] 'rst-mark-section
561 ;; same as mark-defun sgml-mark-current-element
562 [?\C-c ?\C-m])
255 ;; Move forward/backward between section titles. 563 ;; Move forward/backward between section titles.
256 (define-key map [(control c) (control n)] 'rst-forward-section) 564 (rst-define-key map [?\C-\M-a] 'rst-forward-section
257 (define-key map [(control c) (control p)] 'rst-backward-section) 565 ;; same as beginning-of-defun
566 [?\C-c ?\C-n])
567 (rst-define-key map [?\C-\M-e] 'rst-backward-section
568 ;; same as end-of-defun
569 [?\C-c ?\C-p])
258 570
259 ;; 571 ;;
260 ;; Operating on Blocks of Text. 572 ;; Operating on regions.
261 ;; 573 ;;
574 ;; \C-c \C-r is the keymap for regions
575 (rst-define-key map [?\C-c ?\C-r ?\C-h] 'describe-prefix-bindings)
576 ;; Makes region a line-block.
577 (rst-define-key map [?\C-c ?\C-r ?\C-l] 'rst-line-block-region
578 [?\C-c ?\C-d])
579 ;; Shift region left or right according to tabs
580 (rst-define-key map [?\C-c ?\C-r tab] 'rst-shift-region
581 [?\C-c ?\C-r t] [?\C-c ?\C-l t])
582
583 ;;
584 ;; Operating on lists.
585 ;;
586 ;; \C-c \C-l is the keymap for lists
587 (rst-define-key map [?\C-c ?\C-l ?\C-h] 'describe-prefix-bindings)
262 ;; Makes paragraphs in region as a bullet list. 588 ;; Makes paragraphs in region as a bullet list.
263 (define-key map [(control c) (control b)] 'rst-bullet-list-region) 589 (rst-define-key map [?\C-c ?\C-l ?\C-b] 'rst-bullet-list-region
590 [?\C-c ?\C-b])
264 ;; Makes paragraphs in region as a enumeration. 591 ;; Makes paragraphs in region as a enumeration.
265 (define-key map [(control c) (control e)] 'rst-enumerate-region) 592 (rst-define-key map [?\C-c ?\C-l ?\C-e] 'rst-enumerate-region
593 [?\C-c ?\C-e])
266 ;; Converts bullets to an enumeration. 594 ;; Converts bullets to an enumeration.
267 (define-key map [(control c) (control v)] 'rst-convert-bullets-to-enumeration) 595 (rst-define-key map [?\C-c ?\C-l ?\C-c] 'rst-convert-bullets-to-enumeration
268 ;; Makes region a line-block. 596 [?\C-c ?\C-v])
269 (define-key map [(control c) (control d)] 'rst-line-block-region)
270 ;; Make sure that all the bullets in the region are consistent. 597 ;; Make sure that all the bullets in the region are consistent.
271 (define-key map [(control c) (control w)] 'rst-straighten-bullets-region) 598 (rst-define-key map [?\C-c ?\C-l ?\C-s] 'rst-straighten-bullets-region
272 ;; Shift region left or right (taking into account of enumerations/bullets, etc.). 599 [?\C-c ?\C-w])
273 (define-key map [(control c) (control l)] 'rst-shift-region-left) 600 ;; Insert a list item
274 (define-key map [(control c) (control r)] 'rst-shift-region-right) 601 (rst-define-key map [?\C-c ?\C-l ?\C-i] 'rst-insert-list)
275 ;; Comment/uncomment the active region.
276 (define-key map [(control c) (control c)] 'comment-region)
277 602
278 ;; 603 ;;
279 ;; Table-of-Contents Features. 604 ;; Table-of-Contents Features.
280 ;; 605 ;;
606 ;; \C-c \C-t is the keymap for table of contents
607 (rst-define-key map [?\C-c ?\C-t ?\C-h] 'describe-prefix-bindings)
281 ;; Enter a TOC buffer to view and move to a specific section. 608 ;; Enter a TOC buffer to view and move to a specific section.
282 (define-key map [(control c) (control t)] 'rst-toc) 609 (rst-define-key map [?\C-c ?\C-t ?\C-t] 'rst-toc)
283 ;; Insert a TOC here. 610 ;; Insert a TOC here.
284 (define-key map [(control c) (control i)] 'rst-toc-insert) 611 (rst-define-key map [?\C-c ?\C-t ?\C-i] 'rst-toc-insert
612 [?\C-c ?\C-i])
285 ;; Update the document's TOC (without changing the cursor position). 613 ;; Update the document's TOC (without changing the cursor position).
286 (define-key map [(control c) (control u)] 'rst-toc-update) 614 (rst-define-key map [?\C-c ?\C-t ?\C-u] 'rst-toc-update
615 [?\C-c ?\C-u])
287 ;; Got to the section under the cursor (cursor must be in TOC). 616 ;; Got to the section under the cursor (cursor must be in TOC).
288 (define-key map [(control c) (control f)] 'rst-goto-section) 617 (rst-define-key map [?\C-c ?\C-t ?\C-j] 'rst-goto-section
618 [?\C-c ?\C-f])
289 619
290 ;; 620 ;;
291 ;; Converting Documents from Emacs. 621 ;; Converting Documents from Emacs.
292 ;; 622 ;;
623 ;; \C-c \C-c is the keymap for compilation
624 (rst-define-key map [?\C-c ?\C-c ?\C-h] 'describe-prefix-bindings)
293 ;; Run one of two pre-configured toolset commands on the document. 625 ;; Run one of two pre-configured toolset commands on the document.
294 (define-key map [(control c) (?1)] 'rst-compile) 626 (rst-define-key map [?\C-c ?\C-c ?\C-c] 'rst-compile
295 (define-key map [(control c) (?2)] 'rst-compile-alt-toolset) 627 [?\C-c ?1])
628 (rst-define-key map [?\C-c ?\C-c ?\C-a] 'rst-compile-alt-toolset
629 [?\C-c ?2])
296 ;; Convert the active region to pseudo-xml using the docutils tools. 630 ;; Convert the active region to pseudo-xml using the docutils tools.
297 (define-key map [(control c) (?3)] 'rst-compile-pseudo-region) 631 (rst-define-key map [?\C-c ?\C-c ?\C-x] 'rst-compile-pseudo-region
632 [?\C-c ?3])
298 ;; Convert the current document to PDF and launch a viewer on the results. 633 ;; Convert the current document to PDF and launch a viewer on the results.
299 (define-key map [(control c) (?4)] 'rst-compile-pdf-preview) 634 (rst-define-key map [?\C-c ?\C-c ?\C-p] 'rst-compile-pdf-preview
635 [?\C-c ?4])
300 ;; Convert the current document to S5 slides and view in a web browser. 636 ;; Convert the current document to S5 slides and view in a web browser.
301 (define-key map [(control c) (?5)] 'rst-compile-slides-preview) 637 (rst-define-key map [?\C-c ?\C-c ?\C-s] 'rst-compile-slides-preview
638 [?\C-c ?5])
302 639
303 map) 640 map)
304 "Keymap for reStructuredText mode commands. 641 "Keymap for reStructuredText mode commands.
@@ -307,7 +644,7 @@ This inherits from Text mode.")
307 644
308;; Abbrevs. 645;; Abbrevs.
309(defvar rst-mode-abbrev-table nil 646(defvar rst-mode-abbrev-table nil
310 "Abbrev table used while in Rst mode.") 647 "Abbrev table used while in `rst-mode'.")
311(define-abbrev-table 'rst-mode-abbrev-table 648(define-abbrev-table 'rst-mode-abbrev-table
312 (mapcar (lambda (x) (append x '(nil 0 system))) 649 (mapcar (lambda (x) (append x '(nil 0 system)))
313 '(("contents" ".. contents::\n..\n ") 650 '(("contents" ".. contents::\n..\n ")
@@ -328,38 +665,34 @@ This inherits from Text mode.")
328 (modify-syntax-entry ?& "." st) 665 (modify-syntax-entry ?& "." st)
329 (modify-syntax-entry ?' "." st) 666 (modify-syntax-entry ?' "." st)
330 (modify-syntax-entry ?* "." st) 667 (modify-syntax-entry ?* "." st)
331 (modify-syntax-entry ?+ "." st) 668 (modify-syntax-entry ?+ "_" st)
332 (modify-syntax-entry ?. "_" st) 669 (modify-syntax-entry ?. "_" st)
333 (modify-syntax-entry ?/ "." st) 670 (modify-syntax-entry ?/ "." st)
671 (modify-syntax-entry ?: "_" st)
334 (modify-syntax-entry ?< "." st) 672 (modify-syntax-entry ?< "." st)
335 (modify-syntax-entry ?= "." st) 673 (modify-syntax-entry ?= "." st)
336 (modify-syntax-entry ?> "." st) 674 (modify-syntax-entry ?> "." st)
337 (modify-syntax-entry ?\\ "\\" st) 675 (modify-syntax-entry ?\\ "\\" st)
338 (modify-syntax-entry ?| "." st) 676 (modify-syntax-entry ?| "." st)
339 (modify-syntax-entry ?_ "." st) 677 (modify-syntax-entry ?_ "_" st)
678 (modify-syntax-entry ?\u00ab "." st)
679 (modify-syntax-entry ?\u00bb "." st)
680 (modify-syntax-entry ?\u2018 "." st)
681 (modify-syntax-entry ?\u2019 "." st)
682 (modify-syntax-entry ?\u201c "." st)
683 (modify-syntax-entry ?\u201d "." st)
340 684
341 st) 685 st)
342 "Syntax table used while in `rst-mode'.") 686 "Syntax table used while in `rst-mode'.")
343 687
344 688
345(defcustom rst-mode-hook nil 689(defcustom rst-mode-hook nil
346 "Hook run when Rst mode is turned on. 690 "Hook run when `rst-mode' is turned on.
347The hook for Text mode is run before this one." 691The hook for `text-mode' is run before this one."
348 :group 'rst 692 :group 'rst
349 :type '(hook)) 693 :type '(hook))
350 694
351 695
352(defcustom rst-mode-lazy t
353 "If non-nil Rst mode tries to font-lock multi-line elements correctly.
354Because this is really slow it should be set to nil if neither `jit-lock-mode'
355not `lazy-lock-mode' and activated.
356
357If nil, comments and literal blocks are font-locked only on the line they start.
358
359The value of this variable is used when Rst mode is turned on."
360 :group 'rst
361 :type '(boolean))
362
363;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files 696;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files
364;; use *.txt, but this is too generic to be set as a default. 697;; use *.txt, but this is too generic to be set as a default.
365;;;###autoload (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) 698;;;###autoload (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode)))
@@ -367,78 +700,74 @@ The value of this variable is used when Rst mode is turned on."
367(define-derived-mode rst-mode text-mode "ReST" 700(define-derived-mode rst-mode text-mode "ReST"
368 "Major mode for editing reStructuredText documents. 701 "Major mode for editing reStructuredText documents.
369\\<rst-mode-map> 702\\<rst-mode-map>
370There are a number of convenient keybindings provided by
371Rst mode. The main one is \\[rst-adjust], it updates or rotates
372the section title around point or promotes/demotes the
373decorations within the region (see full details below).
374Use negative prefix arg to rotate in the other direction.
375 703
376Turning on `rst-mode' calls the normal hooks `text-mode-hook' 704Turning on `rst-mode' calls the normal hooks `text-mode-hook'
377and `rst-mode-hook'. This mode also supports font-lock 705and `rst-mode-hook'. This mode also supports font-lock
378highlighting. You may customize `rst-mode-lazy' to toggle 706highlighting.
379font-locking of blocks.
380 707
381\\{rst-mode-map}" 708\\{rst-mode-map}"
382 :abbrev-table rst-mode-abbrev-table 709 :abbrev-table rst-mode-abbrev-table
383 :syntax-table rst-mode-syntax-table 710 :syntax-table rst-mode-syntax-table
384 :group 'rst 711 :group 'rst
385 712
386 (set (make-local-variable 'paragraph-separate) paragraph-start) 713 ;; Paragraph recognition
387 (set (make-local-variable 'indent-line-function) 'indent-relative-maybe) 714 (set (make-local-variable 'paragraph-separate)
715 (rst-re '(:alt
716 "\f"
717 lin-end)))
388 (set (make-local-variable 'paragraph-start) 718 (set (make-local-variable 'paragraph-start)
389 "\f\\|>*[ \t]*$\\|>*[ \t]*[-+*] \\|>*[ \t]*[0-9#]+\\. ") 719 (rst-re '(:alt
390 (set (make-local-variable 'adaptive-fill-mode) t) 720 "\f"
721 lin-end
722 (:seq hws-tag par-tag- bli-sfx))))
391 723
392 ;; FIXME: No need to reset this. 724 ;; Indenting and filling
393 ;; (set (make-local-variable 'indent-line-function) 'indent-relative) 725 (set (make-local-variable 'indent-line-function) 'rst-indent-line)
726 (set (make-local-variable 'adaptive-fill-mode) t)
727 (set (make-local-variable 'adaptive-fill-regexp)
728 (rst-re 'hws-tag 'par-tag- "?" 'hws-tag))
729 (set (make-local-variable 'adaptive-fill-function) 'rst-adaptive-fill)
730 (set (make-local-variable 'fill-paragraph-handle-comment) nil)
394 731
395 ;; The details of the following comment setup is important because it affects 732 ;; Comments
396 ;; auto-fill, and it is pretty common in running text to have an ellipsis
397 ;; ("...") which trips because of the rest comment syntax (".. ").
398 (set (make-local-variable 'comment-start) ".. ") 733 (set (make-local-variable 'comment-start) ".. ")
399 (set (make-local-variable 'comment-start-skip) "^\\.\\. ") 734 (set (make-local-variable 'comment-start-skip)
400 (set (make-local-variable 'comment-multi-line) nil) 735 (rst-re 'lin-beg 'exm-tag 'bli-sfx))
401 736 (set (make-local-variable 'comment-continue) " ")
402 ;; Special variables 737 (set (make-local-variable 'comment-multi-line) t)
403 (make-local-variable 'rst-adornment-level-alist) 738 (set (make-local-variable 'comment-use-syntax) nil)
739 ;; reStructuredText has not really a comment ender but nil is not really a
740 ;; permissible value
741 (set (make-local-variable 'comment-end) "")
742 (set (make-local-variable 'comment-end-skip) nil)
743
744 (set (make-local-variable 'comment-line-break-function)
745 'rst-comment-line-break)
746 (set (make-local-variable 'comment-indent-function)
747 'rst-comment-indent)
748 (set (make-local-variable 'comment-insert-comment-function)
749 'rst-comment-insert-comment)
750 (set (make-local-variable 'comment-region-function)
751 'rst-comment-region)
752 (set (make-local-variable 'uncomment-region-function)
753 'rst-uncomment-region)
404 754
405 ;; Font lock 755 ;; Font lock
406 (set (make-local-variable 'font-lock-defaults) 756 (setq font-lock-defaults
407 '(rst-font-lock-keywords-function 757 '(rst-font-lock-keywords
408 t nil nil nil 758 t nil nil nil
409 (font-lock-mark-block-function . mark-paragraph))) 759 (font-lock-multiline . t)
410 ;; `jit-lock-mode' has been the default since Emacs-21.1, so there's no 760 (font-lock-mark-block-function . mark-paragraph)
411 ;; point messing around with font-lock-support-mode any more. 761 ;; rst-mode does not need font-lock-support-mode because it's fast
412 ;; (when (boundp 'font-lock-support-mode) 762 ;; enough. In fact using `jit-lock-mode` slows things down
413 ;; ;; rst-mode has its own mind about font-lock-support-mode 763 ;; considerably even if `rst-font-lock-extend-region` is in place and
414 ;; (make-local-variable 'font-lock-support-mode) 764 ;; compiled.
415 ;; ;; jit-lock-mode replaced lazy-lock-mode in GNU Emacs 21. 765 ;;(font-lock-support-mode . nil)
416 ;; (let ((jit-or-lazy-lock-mode 766 ))
417 ;; (cond 767 (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t)
418 ;; ((fboundp 'lazy-lock-mode) 'lazy-lock-mode) 768
419 ;; ((fboundp 'jit-lock-mode) 'jit-lock-mode) 769 ;; Text after a changed line may need new fontification
420 ;; ;; if neither lazy-lock nor jit-lock is supported, 770 (set (make-local-variable 'jit-lock-contextually) t))
421 ;; ;; tell user and disable rst-mode-lazy
422 ;; (t (when rst-mode-lazy
423 ;; (message "Disabled lazy fontification, because no known support mode found.")
424 ;; (setq rst-mode-lazy nil))))))
425 ;; (cond
426 ;; ((and (not rst-mode-lazy) (not font-lock-support-mode)))
427 ;; ;; No support mode set and none required - leave it alone
428 ;; ((or (not font-lock-support-mode) ;; No support mode set (but required)
429 ;; (symbolp font-lock-support-mode)) ;; or a fixed mode for all
430 ;; (setq font-lock-support-mode
431 ;; (list (cons 'rst-mode (and rst-mode-lazy jit-or-lazy-lock-mode))
432 ;; (cons t font-lock-support-mode))))
433 ;; ((and (listp font-lock-support-mode)
434 ;; (not (assoc 'rst-mode font-lock-support-mode)))
435 ;; ;; A list of modes missing rst-mode
436 ;; (setq font-lock-support-mode
437 ;; (cons (cons 'rst-mode (and rst-mode-lazy jit-or-lazy-lock-mode))
438 ;; font-lock-support-mode))))))
439
440 )
441
442 771
443;;;###autoload 772;;;###autoload
444(define-minor-mode rst-minor-mode 773(define-minor-mode rst-minor-mode
@@ -462,31 +791,19 @@ for modes derived from Text mode, like Mail mode."
462;; :abbrev-table rst-mode-abbrev-table 791;; :abbrev-table rst-mode-abbrev-table
463;; :syntax-table rst-mode-syntax-table 792;; :syntax-table rst-mode-syntax-table
464 793
465
466
467
468
469;; Bulleted item lists.
470(defcustom rst-bullets
471 '(?- ?* ?+)
472 "List of all possible bullet characters for bulleted lists."
473 :group 'rst)
474
475
476
477 794
478;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 795;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
479;; Section Decoration Adjustment 796;; Section Adornment Adjustment
480;; ============================= 797;; ============================
481;; 798;;
482;; The following functions implement a smart automatic title sectioning feature. 799;; The following functions implement a smart automatic title sectioning feature.
483;; The idea is that with the cursor sitting on a section title, we try to get as 800;; The idea is that with the cursor sitting on a section title, we try to get as
484;; much information from context and try to do the best thing automatically. 801;; much information from context and try to do the best thing automatically.
485;; This function can be invoked many times and/or with prefix argument to rotate 802;; This function can be invoked many times and/or with prefix argument to rotate
486;; between the various sectioning decorations. 803;; between the various sectioning adornments.
487;; 804;;
488;; Definitions: the two forms of sectioning define semantically separate section 805;; Definitions: the two forms of sectioning define semantically separate section
489;; levels. A sectioning DECORATION consists in: 806;; levels. A sectioning ADORNMENT consists in:
490;; 807;;
491;; - a CHARACTER 808;; - a CHARACTER
492;; 809;;
@@ -496,10 +813,7 @@ for modes derived from Text mode, like Mail mode."
496;; how many characters and over-and-under style is hanging outside of the 813;; how many characters and over-and-under style is hanging outside of the
497;; title at the beginning and ending. 814;; title at the beginning and ending.
498;; 815;;
499;; Important note: an existing decoration must be formed by at least two 816;; Here are two examples of adornments (| represents the window border, column
500;; characters to be recognized.
501;;
502;; Here are two examples of decorations (| represents the window border, column
503;; 0): 817;; 0):
504;; 818;;
505;; | 819;; |
@@ -516,17 +830,15 @@ for modes derived from Text mode, like Mail mode."
516;; - The underlining character that is used depends on context. The file is 830;; - The underlining character that is used depends on context. The file is
517;; scanned to find other sections and an appropriate character is selected. 831;; scanned to find other sections and an appropriate character is selected.
518;; If the function is invoked on a section that is complete, the character is 832;; If the function is invoked on a section that is complete, the character is
519;; rotated among the existing section decorations. 833;; rotated among the existing section adornments.
520;; 834;;
521;; Note that when rotating the characters, if we come to the end of the 835;; Note that when rotating the characters, if we come to the end of the
522;; hierarchy of decorations, the variable rst-preferred-decorations is 836;; hierarchy of adornments, the variable rst-preferred-adornments is
523;; consulted to propose a new underline decoration, and if continued, we cycle 837;; consulted to propose a new underline adornment, and if continued, we cycle
524;; the decorations all over again. Set this variable to nil if you want to 838;; the adornments all over again. Set this variable to nil if you want to
525;; limit the underlining character propositions to the existing decorations in 839;; limit the underlining character propositions to the existing adornments in
526;; the file. 840;; the file.
527;; 841;;
528;; - A prefix argument can be used to alternate the style.
529;;
530;; - An underline/overline that is not extended to the column at which it should 842;; - An underline/overline that is not extended to the column at which it should
531;; be hanging is dubbed INCOMPLETE. For example:: 843;; be hanging is dubbed INCOMPLETE. For example::
532;; 844;;
@@ -547,128 +859,108 @@ for modes derived from Text mode, like Mail mode."
547;; 859;;
548;; In over-and-under style, when alternating the style, a variable is 860;; In over-and-under style, when alternating the style, a variable is
549;; available to select how much default indent to use (it can be zero). Note 861;; available to select how much default indent to use (it can be zero). Note
550;; that if the current section decoration already has an indent, we don't 862;; that if the current section adornment already has an indent, we don't
551;; adjust it to the default, we rather use the current indent that is already 863;; adjust it to the default, we rather use the current indent that is already
552;; there for adjustment (unless we cycle, in which case we use the indent 864;; there for adjustment (unless we cycle, in which case we use the indent
553;; that has been found previously). 865;; that has been found previously).
554 866
555(defgroup rst-adjust nil 867(defgroup rst-adjust nil
556 "Settings for adjustment and cycling of section title decorations." 868 "Settings for adjustment and cycling of section title adornments."
557 :group 'rst 869 :group 'rst
558 :version "21.1") 870 :version "21.1")
559 871
560(defcustom rst-preferred-decorations '( (?= over-and-under 1) 872(define-obsolete-variable-alias
561 (?= simple 0) 873 'rst-preferred-decorations 'rst-preferred-adornments "r6506")
562 (?- simple 0) 874(defcustom rst-preferred-adornments '((?= over-and-under 1)
563 (?~ simple 0) 875 (?= simple 0)
564 (?+ simple 0) 876 (?- simple 0)
565 (?` simple 0) 877 (?~ simple 0)
566 (?# simple 0) 878 (?+ simple 0)
567 (?@ simple 0) ) 879 (?` simple 0)
568 "Preferred ordering of section title decorations. 880 (?# simple 0)
569 881 (?@ simple 0))
570This sequence is consulted to offer a new decoration suggestion 882 "Preferred hierarchy of section title adornments.
883
884A list consisting of lists of the form (CHARACTER STYLE INDENT).
885CHARACTER is the character used. STYLE is one of the symbols
886OVER-AND-UNDER or SIMPLE. INDENT is an integer giving the wanted
887indentation for STYLE OVER-AND-UNDER. CHARACTER and STYLE are
888always used when a section adornment is described. In other
889places t instead of a list stands for a transition.
890
891This sequence is consulted to offer a new adornment suggestion
571when we rotate the underlines at the end of the existing 892when we rotate the underlines at the end of the existing
572hierarchy of characters, or when there is no existing section 893hierarchy of characters, or when there is no existing section
573title in the file." 894title in the file.
574 :group 'rst-adjust) 895
575 896Set this to an empty list to use only the adornment found in the
897file."
898 :group 'rst-adjust
899 :type `(repeat
900 (group :tag "Adornment specification"
901 (choice :tag "Adornment character"
902 ,@(mapcar (lambda (char)
903 (list 'const
904 :tag (char-to-string char) char))
905 rst-adornment-chars))
906 (radio :tag "Adornment type"
907 (const :tag "Overline and underline" over-and-under)
908 (const :tag "Underline only" simple))
909 (integer :tag "Indentation for overline and underline type"
910 :value 0))))
576 911
577(defcustom rst-default-indent 1 912(defcustom rst-default-indent 1
578 "Number of characters to indent the section title. 913 "Number of characters to indent the section title.
579 914
580This is used for when toggling decoration styles, when switching 915This is used for when toggling adornment styles, when switching
581from a simple decoration style to a over-and-under decoration 916from a simple adornment style to a over-and-under adornment
582style." 917style."
583 :group 'rst-adjust) 918 :group 'rst-adjust
584 919 :type '(integer))
585
586(defvar rst-section-text-regexp "^[ \t]*\\S-*\\w\\S-*"
587 "Regular expression for valid section title text.")
588
589
590(defun rst-line-homogeneous-p (&optional accept-special)
591 "Return true if the line is homogeneous.
592
593Predicate that returns the unique char if the current line is
594composed only of a single repeated non-whitespace character.
595This returns the char even if there is whitespace at the
596beginning of the line.
597
598If ACCEPT-SPECIAL is specified we do not ignore special sequences
599which normally we would ignore when doing a search on many lines.
600For example, normally we have cases to ignore commonly occurring
601patterns, such as :: or ...; with the flag do not ignore them."
602 (save-excursion
603 (back-to-indentation)
604 (unless (looking-at "\n")
605 (let ((c (thing-at-point 'char)))
606 (if (and (looking-at (format "[%s]+[ \t]*$" c))
607 (or accept-special
608 (and
609 ;; Common patterns.
610 (not (looking-at "::[ \t]*$"))
611 (not (looking-at "\\.\\.\\.[ \t]*$"))
612 ;; Discard one char line
613 (not (looking-at ".[ \t]*$"))
614 )))
615 (string-to-char c))
616 ))
617 ))
618
619(defun rst-line-homogeneous-nodent-p (&optional accept-special)
620 "Return true if the line is homogeneous with no indent.
621See `rst-line-homogeneous-p' about ACCEPT-SPECIAL."
622 (save-excursion
623 (beginning-of-line)
624 (if (looking-at "^[ \t]+")
625 nil
626 (rst-line-homogeneous-p accept-special)
627 )))
628 920
629 921
630(defun rst-compare-decorations (deco1 deco2) 922(defun rst-compare-adornments (ado1 ado2)
631 "Compare decorations. 923 "Compare adornments.
632Return true if both DECO1 and DECO2 decorations are equal, 924Return true if both ADO1 and ADO2 adornments are equal,
633according to restructured text semantics (only the character and 925according to restructured text semantics (only the character and
634the style are compared, the indentation does not matter)." 926the style are compared, the indentation does not matter)."
635 (and (eq (car deco1) (car deco2)) 927 (and (eq (car ado1) (car ado2))
636 (eq (cadr deco1) (cadr deco2)))) 928 (eq (cadr ado1) (cadr ado2))))
637 929
638 930
639(defun rst-get-decoration-match (hier deco) 931(defun rst-get-adornment-match (hier ado)
640 "Return the index (level) in hierarchy HIER of decoration DECO. 932 "Return the index (level) in hierarchy HIER of adornment ADO.
641This basically just searches for the item using the appropriate 933This basically just searches for the item using the appropriate
642comparison and returns the index. Return nil if the item is 934comparison and returns the index. Return nil if the item is
643not found." 935not found."
644 (let ((cur hier)) 936 (let ((cur hier))
645 (while (and cur (not (rst-compare-decorations (car cur) deco))) 937 (while (and cur (not (rst-compare-adornments (car cur) ado)))
646 (setq cur (cdr cur))) 938 (setq cur (cdr cur)))
647 cur)) 939 cur))
648 940
649 941
650(defun rst-suggest-new-decoration (alldecos &optional prev) 942(defun rst-suggest-new-adornment (allados &optional prev)
651 "Suggest a new, different decoration from all that have been seen. 943 "Suggest a new, different adornment from all that have been seen.
652 944
653ALLDECOS is the set of all decorations, including the line numbers. 945ALLADOS is the set of all adornments, including the line numbers.
654PREV is the optional previous decoration, in order to suggest a 946PREV is the optional previous adornment, in order to suggest a
655better match." 947better match."
656 948
657 ;; For all the preferred decorations... 949 ;; For all the preferred adornments...
658 (let* ( 950 (let* (
659 ;; If 'prev' is given, reorder the list to start searching after the 951 ;; If 'prev' is given, reorder the list to start searching after the
660 ;; match. 952 ;; match.
661 (fplist 953 (fplist
662 (cdr (rst-get-decoration-match rst-preferred-decorations prev))) 954 (cdr (rst-get-adornment-match rst-preferred-adornments prev)))
663 955
664 ;; List of candidates to search. 956 ;; List of candidates to search.
665 (curpotential (append fplist rst-preferred-decorations))) 957 (curpotential (append fplist rst-preferred-adornments)))
666 (while 958 (while
667 ;; For all the decorations... 959 ;; For all the adornments...
668 (let ((cur alldecos) 960 (let ((cur allados)
669 found) 961 found)
670 (while (and cur (not found)) 962 (while (and cur (not found))
671 (if (rst-compare-decorations (car cur) (car curpotential)) 963 (if (rst-compare-adornments (car cur) (car curpotential))
672 ;; Found it! 964 ;; Found it!
673 (setq found (car curpotential)) 965 (setq found (car curpotential))
674 (setq cur (cdr cur)))) 966 (setq cur (cdr cur))))
@@ -684,7 +976,7 @@ better match."
684 (line-beginning-position 2))) 976 (line-beginning-position 2)))
685 977
686(defun rst-update-section (char style &optional indent) 978(defun rst-update-section (char style &optional indent)
687 "Unconditionally update the style of a section decoration. 979 "Unconditionally update the style of a section adornment.
688 980
689Do this using the given character CHAR, with STYLE 'simple 981Do this using the given character CHAR, with STYLE 'simple
690or 'over-and-under, and with indent INDENT. If the STYLE 982or 'over-and-under, and with indent INDENT. If the STYLE
@@ -692,11 +984,9 @@ is 'simple, whitespace before the title is removed (indent
692is always assumed to be 0). 984is always assumed to be 0).
693 985
694If there are existing overline and/or underline from the 986If there are existing overline and/or underline from the
695existing decoration, they are removed before adding the 987existing adornment, they are removed before adding the
696requested decoration." 988requested adornment."
697 989 (end-of-line)
698 (interactive)
699 (end-of-line)
700 (let ((marker (point-marker)) 990 (let ((marker (point-marker))
701 len) 991 len)
702 992
@@ -713,21 +1003,20 @@ requested decoration."
713 ;; Set the current column, we're at the end of the title line 1003 ;; Set the current column, we're at the end of the title line
714 (setq len (+ (current-column) indent)) 1004 (setq len (+ (current-column) indent))
715 1005
716 ;; Remove previous line if it consists only of a single repeated character 1006 ;; Remove previous line if it is an adornment
717 (save-excursion 1007 (save-excursion
718 (forward-line -1) 1008 (forward-line -1)
719 (and (rst-line-homogeneous-p 1) 1009 (if (and (looking-at (rst-re 'ado-beg-2-1))
720 ;; Avoid removing the underline of a title right above us. 1010 ;; Avoid removing the underline of a title right above us.
721 (save-excursion (forward-line -1) 1011 (save-excursion (forward-line -1)
722 (not (looking-at rst-section-text-regexp))) 1012 (not (looking-at (rst-re 'ttl-beg)))))
723 (rst-delete-entire-line))) 1013 (rst-delete-entire-line)))
724 1014
725 ;; Remove following line if it consists only of a single repeated 1015 ;; Remove following line if it is an adornment
726 ;; character
727 (save-excursion 1016 (save-excursion
728 (forward-line +1) 1017 (forward-line +1)
729 (and (rst-line-homogeneous-p 1) 1018 (if (looking-at (rst-re 'ado-beg-2-1))
730 (rst-delete-entire-line)) 1019 (rst-delete-entire-line))
731 ;; Add a newline if we're at the end of the buffer, for the subsequence 1020 ;; Add a newline if we're at the end of the buffer, for the subsequence
732 ;; inserting of the underline 1021 ;; inserting of the underline
733 (if (= (point) (buffer-end 1)) 1022 (if (= (point) (buffer-end 1))
@@ -749,186 +1038,277 @@ requested decoration."
749 (goto-char marker) 1038 (goto-char marker)
750 )) 1039 ))
751 1040
1041(defun rst-classify-adornment (adornment end)
1042 "Classify adornment for section titles and transitions.
1043ADORNMENT is the complete adornment string as found in the buffer
1044with optional trailing whitespace. END is the point after the
1045last character of ADORNMENT.
752 1046
753(defun rst-normalize-cursor-position () 1047Return a list. The first entry is t for a transition or a
754 "Normalize the cursor position. 1048cons (CHARACTER . STYLE). Check `rst-preferred-adornments' for
755If the cursor is on a decoration line or an empty line , place it 1049the meaning of CHARACTER and STYLE.
756on the section title line (at the end). Returns the line offset
757by which the cursor was moved. This works both over or under a
758line."
759 (if (save-excursion (beginning-of-line)
760 (or (rst-line-homogeneous-p 1)
761 (looking-at "^[ \t]*$")))
762 (progn
763 (beginning-of-line)
764 (cond
765 ((save-excursion (forward-line -1)
766 (beginning-of-line)
767 (and (looking-at rst-section-text-regexp)
768 (not (rst-line-homogeneous-p 1))))
769 (progn (forward-line -1) -1))
770 ((save-excursion (forward-line +1)
771 (beginning-of-line)
772 (and (looking-at rst-section-text-regexp)
773 (not (rst-line-homogeneous-p 1))))
774 (progn (forward-line +1) +1))
775 (t 0)))
776 0 ))
777
778
779(defun rst-find-all-decorations ()
780 "Find all the decorations in the file.
781Return a list of (line, decoration) pairs. Each decoration
782consists in a (char, style, indent) triple.
783
784This function does not detect the hierarchy of decorations, it
785just finds all of them in a file. You can then invoke another
786function to remove redundancies and inconsistencies."
787
788 (let ((positions ())
789 (curline 1))
790 ;; Iterate over all the section titles/decorations in the file.
791 (save-excursion
792 (goto-char (point-min))
793 (while (< (point) (buffer-end 1))
794 (if (rst-line-homogeneous-nodent-p)
795 (progn
796 (setq curline (+ curline (rst-normalize-cursor-position)))
797
798 ;; Here we have found a potential site for a decoration,
799 ;; characterize it.
800 (let ((deco (rst-get-decoration)))
801 (if (cadr deco) ;; Style is existing.
802 ;; Found a real decoration site.
803 (progn
804 (push (cons curline deco) positions)
805 ;; Push beyond the underline.
806 (forward-line 1)
807 (setq curline (+ curline 1))
808 )))
809 ))
810 (forward-line 1)
811 (setq curline (+ curline 1))
812 ))
813 (reverse positions)))
814
815 1050
816(defun rst-infer-hierarchy (decorations) 1051The remaining list forms four match groups as returned by
817 "Build a hierarchy of decorations using the list of given DECORATIONS. 1052`match-data'. Match group 0 matches the whole construct. Match
1053group 1 matches the overline adornment if present. Match group 2
1054matches the section title text or the transition. Match group 3
1055matches the underline adornment.
818 1056
819This function expects a list of (char, style, indent) decoration 1057Return nil if no syntactically valid adornment is found."
1058 (save-excursion
1059 (save-match-data
1060 (when (string-match (rst-re 'ado-beg-2-1) adornment)
1061 (goto-char end)
1062 (let* ((ado-ch (string-to-char (match-string 2 adornment)))
1063 (ado-re (rst-re ado-ch 'adorep3-hlp))
1064 (end-pnt (point))
1065 (beg-pnt (progn
1066 (forward-line 0)
1067 (point)))
1068 (nxt-emp ; Next line inexistant or empty
1069 (save-excursion
1070 (or (not (zerop (forward-line 1)))
1071 (looking-at (rst-re 'lin-end)))))
1072 (prv-emp ; Previous line inexistant or empty
1073 (save-excursion
1074 (or (not (zerop (forward-line -1)))
1075 (looking-at (rst-re 'lin-end)))))
1076 (ttl-blw ; Title found below starting here
1077 (save-excursion
1078 (and
1079 (zerop (forward-line 1))
1080 (looking-at (rst-re 'ttl-beg))
1081 (point))))
1082 (ttl-abv ; Title found above starting here
1083 (save-excursion
1084 (and
1085 (zerop (forward-line -1))
1086 (looking-at (rst-re 'ttl-beg))
1087 (point))))
1088 (und-fnd ; Matching underline found starting here
1089 (save-excursion
1090 (and ttl-blw
1091 (zerop (forward-line 2))
1092 (looking-at (rst-re ado-re 'lin-end))
1093 (point))))
1094 (ovr-fnd ; Matching overline found starting here
1095 (save-excursion
1096 (and ttl-abv
1097 (zerop (forward-line -2))
1098 (looking-at (rst-re ado-re 'lin-end))
1099 (point))))
1100 key beg-ovr end-ovr beg-txt end-txt beg-und end-und)
1101 (cond
1102 ((and nxt-emp prv-emp)
1103 ;; A transition
1104 (setq key t
1105 beg-txt beg-pnt
1106 end-txt end-pnt))
1107 ((or und-fnd ovr-fnd)
1108 ;; An overline with an underline
1109 (setq key (cons ado-ch 'over-and-under))
1110 (let (;; Prefer overline match over underline match
1111 (und-pnt (if ovr-fnd beg-pnt und-fnd))
1112 (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt))
1113 (txt-pnt (if ovr-fnd ttl-abv ttl-blw)))
1114 (goto-char ovr-pnt)
1115 (setq beg-ovr (point)
1116 end-ovr (line-end-position))
1117 (goto-char txt-pnt)
1118 (setq beg-txt (point)
1119 end-txt (line-end-position))
1120 (goto-char und-pnt)
1121 (setq beg-und (point)
1122 end-und (line-end-position))))
1123 (ttl-abv
1124 ;; An underline
1125 (setq key (cons ado-ch 'simple)
1126 beg-und beg-pnt
1127 end-und end-pnt)
1128 (goto-char ttl-abv)
1129 (setq beg-txt (point)
1130 end-txt (line-end-position)))
1131 (t
1132 ;; Invalid adornment
1133 (setq key nil)))
1134 (if key
1135 (list key
1136 (or beg-ovr beg-txt beg-und)
1137 (or end-und end-txt end-ovr)
1138 beg-ovr end-ovr beg-txt end-txt beg-und end-und)))))))
1139
1140(defun rst-find-title-line ()
1141 "Find a section title line around point and return its characteristics.
1142If the point is on an adornment line find the respective title
1143line. If the point is on an empty line check previous or next
1144line whether it is a suitable title line and use it if so. If
1145point is on a suitable title line use it.
1146
1147If no title line is found return nil.
1148
1149Otherwise return as `rst-classify-adornment' does. However, if
1150the title line has no syntactically valid adornment STYLE is nil
1151in the first element. If there is no adornment around the title
1152CHARACTER is also nil and match groups for overline and underline
1153are nil."
1154 (save-excursion
1155 (forward-line 0)
1156 (let ((orig-pnt (point))
1157 (orig-end (line-end-position)))
1158 (cond
1159 ((looking-at (rst-re 'ado-beg-2-1))
1160 (let ((char (string-to-char (match-string-no-properties 2)))
1161 (r (rst-classify-adornment (match-string-no-properties 0)
1162 (match-end 0))))
1163 (cond
1164 ((not r)
1165 ;; Invalid adornment - check whether this is an incomplete overline
1166 (if (and
1167 (zerop (forward-line 1))
1168 (looking-at (rst-re 'ttl-beg)))
1169 (list (cons char nil) orig-pnt (line-end-position)
1170 orig-pnt orig-end (point) (line-end-position) nil nil)))
1171 ((consp (car r))
1172 ;; A section title - not a transition
1173 r))))
1174 ((looking-at (rst-re 'lin-end))
1175 (or
1176 (save-excursion
1177 (if (and (zerop (forward-line -1))
1178 (looking-at (rst-re 'ttl-beg)))
1179 (list (cons nil nil) (point) (line-end-position)
1180 nil nil (point) (line-end-position) nil nil)))
1181 (save-excursion
1182 (if (and (zerop (forward-line 1))
1183 (looking-at (rst-re 'ttl-beg)))
1184 (list (cons nil nil) (point) (line-end-position)
1185 nil nil (point) (line-end-position) nil nil)))))
1186 ((looking-at (rst-re 'ttl-beg))
1187 ;; Try to use the underline
1188 (let ((r (rst-classify-adornment
1189 (buffer-substring-no-properties
1190 (line-beginning-position 2) (line-end-position 2))
1191 (line-end-position 2))))
1192 (if r
1193 r
1194 ;; No valid adornment found
1195 (list (cons nil nil) (point) (line-end-position)
1196 nil nil (point) (line-end-position) nil nil))))))))
1197
1198;; The following function and variables are used to maintain information about
1199;; current section adornment in a buffer local cache. Thus they can be used for
1200;; font-locking and manipulation commands.
1201
1202(defun rst-reset-section-caches ()
1203 "Reset all section cache variables.
1204Should be called by interactive functions which deal with sections."
1205 (setq rst-all-sections nil
1206 rst-section-hierarchy nil))
1207
1208(defvar rst-all-sections nil
1209 "All section adornments in the buffer as found by `rst-find-all-adornments'.
1210t when no section adornments were found.")
1211(make-variable-buffer-local 'rst-all-sections)
1212
1213;; FIXME: If this variable is set to a different value font-locking of section
1214;; headers is wrong
1215(defvar rst-section-hierarchy nil
1216 "Section hierarchy in the buffer as determined by `rst-get-hierarchy'.
1217t when no section adornments were found. Value depends on
1218`rst-all-sections'.")
1219(make-variable-buffer-local 'rst-section-hierarchy)
1220
1221(defun rst-find-all-adornments ()
1222 "Return all the section adornments in the current buffer.
1223Return a list of (LINE . ADORNMENT) with ascending LINE where
1224LINE is the line containing the section title. ADORNMENT consists
1225of a (CHARACTER STYLE INDENT) triple as described for
1226`rst-preferred-adornments'.
1227
1228Uses and sets `rst-all-sections'."
1229 (unless rst-all-sections
1230 (let (positions)
1231 ;; Iterate over all the section titles/adornments in the file.
1232 (save-excursion
1233 (goto-char (point-min))
1234 (while (re-search-forward (rst-re 'ado-beg-2-1) nil t)
1235 (let ((ado-data (rst-classify-adornment
1236 (match-string-no-properties 0) (point))))
1237 (when (and ado-data
1238 (consp (car ado-data))) ; Ignore transitions
1239 (set-match-data (cdr ado-data))
1240 (goto-char (match-beginning 2)) ; Goto the title start
1241 (push (cons (1+ (count-lines (point-min) (point)))
1242 (list (caar ado-data)
1243 (cdar ado-data)
1244 (current-indentation)))
1245 positions)
1246 (goto-char (match-end 0))))) ; Go beyond the whole thing
1247 (setq positions (nreverse positions))
1248 (setq rst-all-sections (or positions t)))))
1249 (if (eq rst-all-sections t)
1250 nil
1251 rst-all-sections))
1252
1253(defun rst-infer-hierarchy (adornments)
1254 "Build a hierarchy of adornments using the list of given ADORNMENTS.
1255
1256ADORNMENTS is a list of (CHARACTER STYLE INDENT) adornment
820specifications, in order that they appear in a file, and will 1257specifications, in order that they appear in a file, and will
821infer a hierarchy of section levels by removing decorations that 1258infer a hierarchy of section levels by removing adornments that
822have already been seen in a forward traversal of the decorations, 1259have already been seen in a forward traversal of the adornments,
823comparing just the character and style. 1260comparing just CHARACTER and STYLE.
824 1261
825Similarly returns a list of (char, style, indent), where each 1262Similarly returns a list of (CHARACTER STYLE INDENT), where each
826list element should be unique." 1263list element should be unique."
827 1264 (let (hierarchy-alist)
828 (let ((hierarchy-alist (list))) 1265 (dolist (x adornments)
829 (dolist (x decorations)
830 (let ((char (car x)) 1266 (let ((char (car x))
831 (style (cadr x))) 1267 (style (cadr x)))
832 (unless (assoc (cons char style) hierarchy-alist) 1268 (unless (assoc (cons char style) hierarchy-alist)
833 (push (cons (cons char style) x) hierarchy-alist)) 1269 (push (cons (cons char style) x) hierarchy-alist))))
834 )) 1270 (mapcar 'cdr (nreverse hierarchy-alist))))
835 1271
836 (mapcar 'cdr (nreverse hierarchy-alist)) 1272(defun rst-get-hierarchy (&optional ignore)
837 ))
838
839
840(defun rst-get-hierarchy (&optional alldecos ignore)
841 "Return the hierarchy of section titles in the file. 1273 "Return the hierarchy of section titles in the file.
842 1274
843Return a list of decorations that represents the hierarchy of 1275Return a list of adornments that represents the hierarchy of
844section titles in the file. Reuse the list of decorations 1276section titles in the file. Each element consists of (CHARACTER
845already computed in ALLDECOS if present. If the line number in 1277STYLE INDENT) as described for `rst-find-all-adornments'. If the
846IGNORE is specified, the decoration found on that line (if there 1278line number in IGNORE is specified, a possibly adornment found on
847is one) is not taken into account when building the hierarchy." 1279that line is not taken into account when building the hierarchy.
848 (let ((all (or alldecos (rst-find-all-decorations)))) 1280
849 (setq all (assq-delete-all ignore all)) 1281Uses and sets `rst-section-hierarchy' unless IGNORE is given."
850 (rst-infer-hierarchy (mapcar 'cdr all)))) 1282 (if (and (not ignore) rst-section-hierarchy)
851 1283 (if (eq rst-section-hierarchy t)
852 1284 nil
853(defun rst-get-decoration (&optional point) 1285 rst-section-hierarchy)
854 "Get the decoration at POINT. 1286 (let ((r (rst-infer-hierarchy
855 1287 (mapcar 'cdr
856Looks around point and finds the characteristics of the 1288 (assq-delete-all
857decoration that is found there. Assumes that the cursor is 1289 ignore
858already placed on the title line (and not on the overline or 1290 (rst-find-all-adornments))))))
859underline). 1291 (setq rst-section-hierarchy
860 1292 (if ignore
861This function returns a (char, style, indent) triple. If the 1293 ;; Clear cache reflecting that a possible update is not
862characters of overline and underline are different, return 1294 ;; reflected
863the underline character. The indent is always calculated. 1295 nil
864A decoration can be said to exist if the style is not nil. 1296 (or r t)))
865 1297 r)))
866A point can be specified to go to the given location before 1298
867extracting the decoration." 1299(defun rst-get-adornments-around ()
868 1300 "Return the adornments around point.
869 (let (char style) 1301Return a list of the previous and next adornments."
870 (save-excursion 1302 (let* ((all (rst-find-all-adornments))
871 (if point (goto-char point))
872 (beginning-of-line)
873 (if (looking-at rst-section-text-regexp)
874 (let* ((over (save-excursion
875 (forward-line -1)
876 (rst-line-homogeneous-nodent-p)))
877
878 (under (save-excursion
879 (forward-line +1)
880 (rst-line-homogeneous-nodent-p)))
881 )
882
883 ;; Check that the line above the overline is not part of a title
884 ;; above it.
885 (if (and over
886 (save-excursion
887 (and (equal (forward-line -2) 0)
888 (looking-at rst-section-text-regexp))))
889 (setq over nil))
890
891 (cond
892 ;; No decoration found, leave all return values nil.
893 ((and (eq over nil) (eq under nil)))
894
895 ;; Overline only, leave all return values nil.
896 ;;
897 ;; Note: we don't return the overline character, but it could
898 ;; perhaps in some cases be used to do something.
899 ((and over (eq under nil)))
900
901 ;; Underline only.
902 ((and under (eq over nil))
903 (setq char under
904 style 'simple))
905
906 ;; Both overline and underline.
907 (t
908 (setq char under
909 style 'over-and-under)))))
910 ;; Return values.
911 (list char style
912 ;; Find indentation.
913 (save-excursion (back-to-indentation) (current-column))))))
914
915
916(defun rst-get-decorations-around (&optional alldecos)
917 "Return the decorations around point.
918
919Given the list of all decorations ALLDECOS (with positions),
920find the decorations before and after the given point.
921A list of the previous and next decorations is returned."
922 (let* ((all (or alldecos (rst-find-all-decorations)))
923 (curline (line-number-at-pos)) 1303 (curline (line-number-at-pos))
924 prev next 1304 prev next
925 (cur all)) 1305 (cur all))
926 1306
927 ;; Search for the decorations around the current line. 1307 ;; Search for the adornments around the current line.
928 (while (and cur (< (caar cur) curline)) 1308 (while (and cur (< (caar cur) curline))
929 (setq prev cur 1309 (setq prev cur
930 cur (cdr cur))) 1310 cur (cdr cur)))
931 ;; 'cur' is the following decoration. 1311 ;; 'cur' is the following adornment.
932 1312
933 (if (and cur (caar cur)) 1313 (if (and cur (caar cur))
934 (setq next (if (= curline (caar cur)) (cdr cur) cur))) 1314 (setq next (if (= curline (caar cur)) (cdr cur) cur)))
@@ -937,23 +1317,21 @@ A list of the previous and next decorations is returned."
937 )) 1317 ))
938 1318
939 1319
940(defun rst-decoration-complete-p (deco) 1320(defun rst-adornment-complete-p (ado)
941 "Return true if the decoration DECO around point is complete." 1321 "Return true if the adornment ADO around point is complete."
942 ;; Note: we assume that the detection of the overline as being the underline 1322 ;; Note: we assume that the detection of the overline as being the underline
943 ;; of a preceding title has already been detected, and has been eliminated 1323 ;; of a preceding title has already been detected, and has been eliminated
944 ;; from the decoration that is given to us. 1324 ;; from the adornment that is given to us.
945 1325
946 ;; There is some sectioning already present, so check if the current 1326 ;; There is some sectioning already present, so check if the current
947 ;; sectioning is complete and correct. 1327 ;; sectioning is complete and correct.
948 (let* ((char (car deco)) 1328 (let* ((char (car ado))
949 (style (cadr deco)) 1329 (style (cadr ado))
950 (indent (caddr deco)) 1330 (indent (caddr ado))
951 (endcol (save-excursion (end-of-line) (current-column))) 1331 (endcol (save-excursion (end-of-line) (current-column)))
952 ) 1332 )
953 (if char 1333 (if char
954 (let ((exps (concat "^" 1334 (let ((exps (rst-re "^" char (format "\\{%d\\}" (+ endcol indent)) "$")))
955 (regexp-quote (make-string (+ endcol indent) char))
956 "$")))
957 (and 1335 (and
958 (save-excursion (forward-line +1) 1336 (save-excursion (forward-line +1)
959 (beginning-of-line) 1337 (beginning-of-line)
@@ -966,57 +1344,56 @@ A list of the previous and next decorations is returned."
966 )) 1344 ))
967 1345
968 1346
969(defun rst-get-next-decoration 1347(defun rst-get-next-adornment
970 (curdeco hier &optional suggestion reverse-direction) 1348 (curado hier &optional suggestion reverse-direction)
971 "Get the next decoration for CURDECO, in given hierarchy HIER. 1349 "Get the next adornment for CURADO, in given hierarchy HIER.
972If suggesting, suggest for new decoration SUGGESTION. 1350If suggesting, suggest for new adornment SUGGESTION.
973REVERSE-DIRECTION is used to reverse the cycling order." 1351REVERSE-DIRECTION is used to reverse the cycling order."
974 1352
975 (let* ( 1353 (let* (
976 (char (car curdeco)) 1354 (char (car curado))
977 (style (cadr curdeco)) 1355 (style (cadr curado))
978 1356
979 ;; Build a new list of decorations for the rotation. 1357 ;; Build a new list of adornments for the rotation.
980 (rotdecos 1358 (rotados
981 (append hier 1359 (append hier
982 ;; Suggest a new decoration. 1360 ;; Suggest a new adornment.
983 (list suggestion 1361 (list suggestion
984 ;; If nothing to suggest, use first decoration. 1362 ;; If nothing to suggest, use first adornment.
985 (car hier)))) ) 1363 (car hier)))) )
986 (or 1364 (or
987 ;; Search for next decoration. 1365 ;; Search for next adornment.
988 (cadr 1366 (cadr
989 (let ((cur (if reverse-direction rotdecos 1367 (let ((cur (if reverse-direction rotados
990 (reverse rotdecos)))) 1368 (reverse rotados))))
991 (while (and cur 1369 (while (and cur
992 (not (and (eq char (caar cur)) 1370 (not (and (eq char (caar cur))
993 (eq style (cadar cur))))) 1371 (eq style (cadar cur)))))
994 (setq cur (cdr cur))) 1372 (setq cur (cdr cur)))
995 cur)) 1373 cur))
996 1374
997 ;; If not found, take the first of all decorations. 1375 ;; If not found, take the first of all adornments.
998 suggestion 1376 suggestion
999 ))) 1377 )))
1000 1378
1001 1379
1002(defun rst-adjust () 1380;; FIXME: A line "``/`` full" is not accepted as a section title
1003 "Auto-adjust the decoration around point. 1381(defun rst-adjust (pfxarg)
1382 "Auto-adjust the adornment around point.
1004 1383
1005Adjust/rotate the section decoration for the section title 1384Adjust/rotate the section adornment for the section title
1006around point or promote/demote the decorations inside the region, 1385around point or promote/demote the adornments inside the region,
1007depending on if the region is active. This function is meant to 1386depending on if the region is active. This function is meant to
1008be invoked possibly multiple times, and can vary its behavior 1387be invoked possibly multiple times, and can vary its behavior
1009with a positive prefix argument (toggle style), or with a 1388with a positive prefix argument (toggle style), or with a
1010negative prefix argument (alternate behavior). 1389negative prefix argument (alternate behavior).
1011 1390
1012This function is the main focus of this module and is a bit of a 1391This function is a bit of a swiss knife. It is meant to adjust
1013swiss knife. It is meant as the single most essential function 1392the adornments of a section title in reStructuredText. It tries
1014to be bound to invoke to adjust the decorations of a section 1393to deal with all the possible cases gracefully and to do `the
1015title in restructuredtext. It tries to deal with all the 1394right thing' in all cases.
1016possible cases gracefully and to do `the right thing' in all
1017cases.
1018 1395
1019See the documentations of `rst-adjust-decoration' and 1396See the documentations of `rst-adjust-adornment-work' and
1020`rst-promote-region' for full details. 1397`rst-promote-region' for full details.
1021 1398
1022Prefix Arguments 1399Prefix Arguments
@@ -1025,28 +1402,24 @@ Prefix Arguments
1025The method can take either (but not both) of 1402The method can take either (but not both) of
1026 1403
1027a. a (non-negative) prefix argument, which means to toggle the 1404a. a (non-negative) prefix argument, which means to toggle the
1028 decoration style. Invoke with a prefix arg for example; 1405 adornment style. Invoke with a prefix arg for example;
1029 1406
1030b. a negative numerical argument, which generally inverts the 1407b. a negative numerical argument, which generally inverts the
1031 direction of search in the file or hierarchy. Invoke with C-- 1408 direction of search in the file or hierarchy. Invoke with C--
1032 prefix for example." 1409 prefix for example."
1033 (interactive) 1410 (interactive "P")
1034 1411
1035 (let* (;; Save our original position on the current line. 1412 (let* (;; Save our original position on the current line.
1036 (origpt (point-marker)) 1413 (origpt (point-marker))
1037 1414
1038 ;; Parse the positive and negative prefix arguments. 1415 (reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0)))
1039 (reverse-direction 1416 (toggle-style (and pfxarg (not reverse-direction))))
1040 (and current-prefix-arg
1041 (< (prefix-numeric-value current-prefix-arg) 0)))
1042 (toggle-style
1043 (and current-prefix-arg (not reverse-direction))))
1044 1417
1045 (if (rst-portable-mark-active-p) 1418 (if (rst-portable-mark-active-p)
1046 ;; Adjust decorations within region. 1419 ;; Adjust adornments within region.
1047 (rst-promote-region current-prefix-arg) 1420 (rst-promote-region (and pfxarg t))
1048 ;; Adjust decoration around point. 1421 ;; Adjust adornment around point.
1049 (rst-adjust-decoration toggle-style reverse-direction)) 1422 (rst-adjust-adornment-work toggle-style reverse-direction))
1050 1423
1051 ;; Run the hooks to run after adjusting. 1424 ;; Run the hooks to run after adjusting.
1052 (run-hooks 'rst-adjust-hook) 1425 (run-hooks 'rst-adjust-hook)
@@ -1056,18 +1429,32 @@ b. a negative numerical argument, which generally inverts the
1056 1429
1057 )) 1430 ))
1058 1431
1059(defvar rst-adjust-hook nil 1432(defcustom rst-adjust-hook nil
1060 "Hooks to be run after running `rst-adjust'.") 1433 "Hooks to be run after running `rst-adjust'."
1434 :group 'rst-adjust
1435 :type '(hook)
1436 :package-version '(rst . "1.1.0"))
1061 1437
1062(defvar rst-new-decoration-down nil 1438(defcustom rst-new-adornment-down nil
1063 "Non-nil if new decoration is added deeper. 1439 "Controls level of new adornment for section headers."
1064If non-nil, a new decoration being added will be initialized to 1440 :group 'rst-adjust
1065be one level down from the previous decoration. If nil, a new 1441 :type '(choice
1066decoration will be equal to the level of the previous 1442 (const :tag "Same level as previous one" nil)
1067decoration.") 1443 (const :tag "One level down relative to the previous one" t))
1444 :package-version '(rst . "1.1.0"))
1068 1445
1069(defun rst-adjust-decoration (&optional toggle-style reverse-direction) 1446(defun rst-adjust-adornment (pfxarg)
1070"Adjust/rotate the section decoration for the section title around point. 1447 "Call `rst-adjust-adornment-work' interactively.
1448
1449Keep this for compatibility for older bindings (are there any?)."
1450 (interactive "P")
1451
1452 (let* ((reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0)))
1453 (toggle-style (and pfxarg (not reverse-direction))))
1454 (rst-adjust-adornment-work toggle-style reverse-direction)))
1455
1456(defun rst-adjust-adornment-work (toggle-style reverse-direction)
1457"Adjust/rotate the section adornment for the section title around point.
1071 1458
1072This function is meant to be invoked possibly multiple times, and 1459This function is meant to be invoked possibly multiple times, and
1073can vary its behavior with a true TOGGLE-STYLE argument, or with 1460can vary its behavior with a true TOGGLE-STYLE argument, or with
@@ -1080,13 +1467,13 @@ The next action it takes depends on context around the point, and
1080it is meant to be invoked possibly more than once to rotate among 1467it is meant to be invoked possibly more than once to rotate among
1081the various possibilities. Basically, this function deals with: 1468the various possibilities. Basically, this function deals with:
1082 1469
1083- adding a decoration if the title does not have one; 1470- adding a adornment if the title does not have one;
1084 1471
1085- adjusting the length of the underline characters to fit a 1472- adjusting the length of the underline characters to fit a
1086 modified title; 1473 modified title;
1087 1474
1088- rotating the decoration in the set of already existing 1475- rotating the adornment in the set of already existing
1089 sectioning decorations used in the file; 1476 sectioning adornments used in the file;
1090 1477
1091- switching between simple and over-and-under styles. 1478- switching between simple and over-and-under styles.
1092 1479
@@ -1095,10 +1482,10 @@ invoke the method and it will do the most obvious thing that you
1095would expect. 1482would expect.
1096 1483
1097 1484
1098Decoration Definitions 1485Adornment Definitions
1099====================== 1486=====================
1100 1487
1101The decorations consist in 1488The adornments consist in
1102 1489
11031. a CHARACTER 14901. a CHARACTER
1104 1491
@@ -1119,71 +1506,69 @@ Here are the gory details of the algorithm (it seems quite
1119complicated, but really, it does the most obvious thing in all 1506complicated, but really, it does the most obvious thing in all
1120the particular cases): 1507the particular cases):
1121 1508
1122Before applying the decoration change, the cursor is placed on 1509Before applying the adornment change, the cursor is placed on
1123the closest line that could contain a section title. 1510the closest line that could contain a section title.
1124 1511
1125Case 1: No Decoration 1512Case 1: No Adornment
1126--------------------- 1513--------------------
1127 1514
1128If the current line has no decoration around it, 1515If the current line has no adornment around it,
1129 1516
1130- search backwards for the last previous decoration, and apply 1517- search backwards for the last previous adornment, and apply
1131 the decoration one level lower to the current line. If there 1518 the adornment one level lower to the current line. If there
1132 is no defined level below this previous decoration, we suggest 1519 is no defined level below this previous adornment, we suggest
1133 the most appropriate of the `rst-preferred-decorations'. 1520 the most appropriate of the `rst-preferred-adornments'.
1134 1521
1135 If REVERSE-DIRECTION is true, we simply use the previous 1522 If REVERSE-DIRECTION is true, we simply use the previous
1136 decoration found directly. 1523 adornment found directly.
1137 1524
1138- if there is no decoration found in the given direction, we use 1525- if there is no adornment found in the given direction, we use
1139 the first of `rst-preferred-decorations'. 1526 the first of `rst-preferred-adornments'.
1140 1527
1141The prefix argument forces a toggle of the prescribed decoration 1528TOGGLE-STYLE forces a toggle of the prescribed adornment style.
1142style.
1143 1529
1144Case 2: Incomplete Decoration 1530Case 2: Incomplete Adornment
1145----------------------------- 1531----------------------------
1146 1532
1147If the current line does have an existing decoration, but the 1533If the current line does have an existing adornment, but the
1148decoration is incomplete, that is, the underline/overline does 1534adornment is incomplete, that is, the underline/overline does
1149not extend to exactly the end of the title line (it is either too 1535not extend to exactly the end of the title line (it is either too
1150short or too long), we simply extend the length of the 1536short or too long), we simply extend the length of the
1151underlines/overlines to fit exactly the section title. 1537underlines/overlines to fit exactly the section title.
1152 1538
1153If the prefix argument is given, we toggle the style of the 1539If TOGGLE-STYLE we toggle the style of the adornment as well.
1154decoration as well.
1155 1540
1156REVERSE-DIRECTION has no effect in this case. 1541REVERSE-DIRECTION has no effect in this case.
1157 1542
1158Case 3: Complete Existing Decoration 1543Case 3: Complete Existing Adornment
1159------------------------------------ 1544-----------------------------------
1160 1545
1161If the decoration is complete (i.e. the underline (overline) 1546If the adornment is complete (i.e. the underline (overline)
1162length is already adjusted to the end of the title line), we 1547length is already adjusted to the end of the title line), we
1163search/parse the file to establish the hierarchy of all the 1548search/parse the file to establish the hierarchy of all the
1164decorations (making sure not to include the decoration around 1549adornments (making sure not to include the adornment around
1165point), and we rotate the current title's decoration from within 1550point), and we rotate the current title's adornment from within
1166that list (by default, going *down* the hierarchy that is present 1551that list (by default, going *down* the hierarchy that is present
1167in the file, i.e. to a lower section level). This is meant to be 1552in the file, i.e. to a lower section level). This is meant to be
1168used potentially multiple times, until the desired decoration is 1553used potentially multiple times, until the desired adornment is
1169found around the title. 1554found around the title.
1170 1555
1171If we hit the boundary of the hierarchy, exactly one choice from 1556If we hit the boundary of the hierarchy, exactly one choice from
1172the list of preferred decorations is suggested/chosen, the first 1557the list of preferred adornments is suggested/chosen, the first
1173of those decoration that has not been seen in the file yet (and 1558of those adornment that has not been seen in the file yet (and
1174not including the decoration around point), and the next 1559not including the adornment around point), and the next
1175invocation rolls over to the other end of the hierarchy (i.e. it 1560invocation rolls over to the other end of the hierarchy (i.e. it
1176cycles). This allows you to avoid having to set which character 1561cycles). This allows you to avoid having to set which character
1177to use. 1562to use.
1178 1563
1179If REVERSE-DIRECTION is true, the effect is to change the 1564If REVERSE-DIRECTION is true, the effect is to change the
1180direction of rotation in the hierarchy of decorations, thus 1565direction of rotation in the hierarchy of adornments, thus
1181instead going *up* the hierarchy. 1566instead going *up* the hierarchy.
1182 1567
1183However, if there is a non-negative prefix argument, we do not 1568However, if TOGGLE-STYLE, we do not rotate the adornment, but
1184rotate the decoration, but instead simply toggle the style of the 1569instead simply toggle the style of the current adornment (this
1185current decoration (this should be the most common way to toggle 1570should be the most common way to toggle the style of an existing
1186the style of an existing complete decoration). 1571complete adornment).
1187 1572
1188 1573
1189Point Location 1574Point Location
@@ -1203,7 +1588,7 @@ Indented section titles such as ::
1203 My Title 1588 My Title
1204 -------- 1589 --------
1205 1590
1206are invalid in restructuredtext and thus not recognized by the 1591are invalid in reStructuredText and thus not recognized by the
1207parser. This code will thus not work in a way that would support 1592parser. This code will thus not work in a way that would support
1208indented sections (it would be ambiguous anyway). 1593indented sections (it would be ambiguous anyway).
1209 1594
@@ -1213,166 +1598,103 @@ Joint Sections
1213 1598
1214Section titles that are right next to each other may not be 1599Section titles that are right next to each other may not be
1215treated well. More work might be needed to support those, and 1600treated well. More work might be needed to support those, and
1216special conditions on the completeness of existing decorations 1601special conditions on the completeness of existing adornments
1217might be required to make it non-ambiguous. 1602might be required to make it non-ambiguous.
1218 1603
1219For now we assume that the decorations are disjoint, that is, 1604For now we assume that the adornments are disjoint, that is,
1220there is at least a single line between the titles/decoration 1605there is at least a single line between the titles/adornment
1221lines. 1606lines."
1222 1607 (rst-reset-section-caches)
1223 1608 (let ((ttl-fnd (rst-find-title-line))
1224Suggested Binding 1609 (orig-pnt (point)))
1225================= 1610 (when ttl-fnd
1226 1611 (set-match-data (cdr ttl-fnd))
1227We suggest that you bind this function on C-=. It is close to 1612 (goto-char (match-beginning 2))
1228C-- so a negative argument can be easily specified with a flick 1613 (let* ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt)))
1229of the right hand fingers and the binding is unused in `text-mode'." 1614 (char (caar ttl-fnd))
1230 (interactive) 1615 (style (cdar ttl-fnd))
1231 1616 (indent (current-indentation))
1232 ;; If we were invoked directly, parse the prefix arguments into the 1617 (curado (list char style indent))
1233 ;; arguments of the function. 1618 char-new style-new indent-new)
1234 (if current-prefix-arg 1619 (cond
1235 (setq reverse-direction 1620 ;;-------------------------------------------------------------------
1236 (and current-prefix-arg 1621 ;; Case 1: No valid adornment
1237 (< (prefix-numeric-value current-prefix-arg) 0)) 1622 ((not style)
1238 1623 (let ((prev (car (rst-get-adornments-around)))
1239 toggle-style 1624 cur
1240 (and current-prefix-arg (not reverse-direction)))) 1625 (hier (rst-get-hierarchy)))
1241 1626 ;; Advance one level down.
1242 (let* (;; Check if we're on an underline around a section title, and move the 1627 (setq cur
1243 ;; cursor to the title if this is the case. 1628 (if prev
1244 (moved (rst-normalize-cursor-position)) 1629 (if (or (and rst-new-adornment-down reverse-direction)
1245 1630 (and (not rst-new-adornment-down)
1246 ;; Find the decoration and completeness around point. 1631 (not reverse-direction)))
1247 (curdeco (rst-get-decoration)) 1632 prev
1248 (char (car curdeco)) 1633 (or (cadr (rst-get-adornment-match hier prev))
1249 (style (cadr curdeco)) 1634 (rst-suggest-new-adornment hier prev)))
1250 (indent (caddr curdeco)) 1635 (copy-sequence (car rst-preferred-adornments))))
1251 1636 ;; Invert the style if requested.
1252 ;; New values to be computed. 1637 (if toggle-style
1253 char-new style-new indent-new 1638 (setcar (cdr cur) (if (eq (cadr cur) 'simple)
1254 ) 1639 'over-and-under 'simple)) )
1255 1640 (setq char-new (car cur)
1256 ;; We've moved the cursor... if we're not looking at some text, we have 1641 style-new (cadr cur)
1257 ;; nothing to do. 1642 indent-new (caddr cur))))
1258 (if (save-excursion (beginning-of-line) 1643 ;;-------------------------------------------------------------------
1259 (looking-at rst-section-text-regexp)) 1644 ;; Case 2: Incomplete Adornment
1260 (progn 1645 ((not (rst-adornment-complete-p curado))
1261 (cond 1646 ;; Invert the style if requested.
1262 ;;------------------------------------------------------------------- 1647 (if toggle-style
1263 ;; Case 1: No Decoration 1648 (setq style (if (eq style 'simple) 'over-and-under 'simple)))
1264 ((and (eq char nil) (eq style nil)) 1649 (setq char-new char
1265 1650 style-new style
1266 (let* ((alldecos (rst-find-all-decorations)) 1651 indent-new indent))
1267 1652 ;;-------------------------------------------------------------------
1268 (around (rst-get-decorations-around alldecos)) 1653 ;; Case 3: Complete Existing Adornment
1269 (prev (car around)) 1654 (t
1270 cur 1655 (if toggle-style
1271 1656 ;; Simply switch the style of the current adornment.
1272 (hier (rst-get-hierarchy alldecos)) 1657 (setq char-new char
1273 ) 1658 style-new (if (eq style 'simple) 'over-and-under 'simple)
1274 1659 indent-new rst-default-indent)
1275 ;; Advance one level down. 1660 ;; Else, we rotate, ignoring the adornment around the current
1276 (setq cur 1661 ;; line...
1277 (if prev 1662 (let* ((hier (rst-get-hierarchy (line-number-at-pos)))
1278 (if (not reverse-direction) 1663 ;; Suggestion, in case we need to come up with something new
1279 (or (funcall (if rst-new-decoration-down 'cadr 'car) 1664 (suggestion (rst-suggest-new-adornment
1280 (rst-get-decoration-match hier prev)) 1665 hier
1281 (rst-suggest-new-decoration hier prev)) 1666 (car (rst-get-adornments-around))))
1282 prev) 1667 (nextado (rst-get-next-adornment
1283 (copy-sequence (car rst-preferred-decorations)))) 1668 curado hier suggestion reverse-direction)))
1284 1669 ;; Indent, if present, always overrides the prescribed indent.
1285 ;; Invert the style if requested. 1670 (setq char-new (car nextado)
1286 (if toggle-style 1671 style-new (cadr nextado)
1287 (setcar (cdr cur) (if (eq (cadr cur) 'simple) 1672 indent-new (caddr nextado))))))
1288 'over-and-under 'simple)) ) 1673 ;; Override indent with present indent!
1289 1674 (setq indent-new (if (> indent 0) indent indent-new))
1290 (setq char-new (car cur) 1675 (if (and char-new style-new)
1291 style-new (cadr cur) 1676 (rst-update-section char-new style-new indent-new))
1292 indent-new (caddr cur)) 1677 ;; Correct the position of the cursor to more accurately reflect where
1293 )) 1678 ;; it was located when the function was invoked.
1294 1679 (unless (zerop moved)
1295 ;;------------------------------------------------------------------- 1680 (forward-line (- moved))
1296 ;; Case 2: Incomplete Decoration 1681 (end-of-line))))))
1297 ((not (rst-decoration-complete-p curdeco))
1298
1299 ;; Invert the style if requested.
1300 (if toggle-style
1301 (setq style (if (eq style 'simple) 'over-and-under 'simple)))
1302
1303 (setq char-new char
1304 style-new style
1305 indent-new indent))
1306
1307 ;;-------------------------------------------------------------------
1308 ;; Case 3: Complete Existing Decoration
1309 (t
1310 (if toggle-style
1311
1312 ;; Simply switch the style of the current decoration.
1313 (setq char-new char
1314 style-new (if (eq style 'simple) 'over-and-under 'simple)
1315 indent-new rst-default-indent)
1316
1317 ;; Else, we rotate, ignoring the decoration around the current
1318 ;; line...
1319 (let* ((alldecos (rst-find-all-decorations))
1320
1321 (hier (rst-get-hierarchy alldecos (line-number-at-pos)))
1322
1323 ;; Suggestion, in case we need to come up with something
1324 ;; new
1325 (suggestion (rst-suggest-new-decoration
1326 hier
1327 (car (rst-get-decorations-around alldecos))))
1328
1329 (nextdeco (rst-get-next-decoration
1330 curdeco hier suggestion reverse-direction))
1331
1332 )
1333
1334 ;; Indent, if present, always overrides the prescribed indent.
1335 (setq char-new (car nextdeco)
1336 style-new (cadr nextdeco)
1337 indent-new (caddr nextdeco))
1338
1339 )))
1340 )
1341
1342 ;; Override indent with present indent!
1343 (setq indent-new (if (> indent 0) indent indent-new))
1344
1345 (if (and char-new style-new)
1346 (rst-update-section char-new style-new indent-new))
1347 ))
1348
1349
1350 ;; Correct the position of the cursor to more accurately reflect where it
1351 ;; was located when the function was invoked.
1352 (unless (= moved 0)
1353 (forward-line (- moved))
1354 (end-of-line))
1355
1356 ))
1357 1682
1358;; Maintain an alias for compatibility. 1683;; Maintain an alias for compatibility.
1359(defalias 'rst-adjust-section-title 'rst-adjust) 1684(defalias 'rst-adjust-section-title 'rst-adjust)
1360 1685
1361 1686
1362(defun rst-promote-region (&optional demote) 1687(defun rst-promote-region (demote)
1363 "Promote the section titles within the region. 1688 "Promote the section titles within the region.
1364 1689
1365With argument DEMOTE or a prefix argument, demote the section 1690With argument DEMOTE or a prefix argument, demote the section
1366titles instead. The algorithm used at the boundaries of the 1691titles instead. The algorithm used at the boundaries of the
1367hierarchy is similar to that used by `rst-adjust-decoration'." 1692hierarchy is similar to that used by `rst-adjust-adornment-work'."
1368 (interactive) 1693 (interactive "P")
1369 1694 (rst-reset-section-caches)
1370 (let* ((demote (or current-prefix-arg demote)) 1695 (let* ((cur (rst-find-all-adornments))
1371 (alldecos (rst-find-all-decorations)) 1696 (hier (rst-get-hierarchy))
1372 (cur alldecos) 1697 (suggestion (rst-suggest-new-adornment hier))
1373
1374 (hier (rst-get-hierarchy alldecos))
1375 (suggestion (rst-suggest-new-decoration hier))
1376 1698
1377 (region-begin-line (line-number-at-pos (region-beginning))) 1699 (region-begin-line (line-number-at-pos (region-beginning)))
1378 (region-end-line (line-number-at-pos (region-end))) 1700 (region-end-line (line-number-at-pos (region-end)))
@@ -1384,7 +1706,7 @@ hierarchy is similar to that used by `rst-adjust-decoration'."
1384 (while (and cur (< (caar cur) region-begin-line)) 1706 (while (and cur (< (caar cur) region-begin-line))
1385 (setq cur (cdr cur))) 1707 (setq cur (cdr cur)))
1386 1708
1387 ;; Create a list of markers for all the decorations which are found within 1709 ;; Create a list of markers for all the adornments which are found within
1388 ;; the region. 1710 ;; the region.
1389 (save-excursion 1711 (save-excursion
1390 (let (line) 1712 (let (line)
@@ -1396,34 +1718,34 @@ hierarchy is similar to that used by `rst-adjust-decoration'."
1396 1718
1397 ;; Apply modifications. 1719 ;; Apply modifications.
1398 (dolist (p marker-list) 1720 (dolist (p marker-list)
1399 ;; Go to the decoration to promote. 1721 ;; Go to the adornment to promote.
1400 (goto-char (car p)) 1722 (goto-char (car p))
1401 1723
1402 ;; Update the decoration. 1724 ;; Update the adornment.
1403 (apply 'rst-update-section 1725 (apply 'rst-update-section
1404 ;; Rotate the next decoration. 1726 ;; Rotate the next adornment.
1405 (rst-get-next-decoration 1727 (rst-get-next-adornment
1406 (cadr p) hier suggestion demote)) 1728 (cadr p) hier suggestion demote))
1407 1729
1408 ;; Clear marker to avoid slowing down the editing after we're done. 1730 ;; Clear marker to avoid slowing down the editing after we're done.
1409 (set-marker (car p) nil)) 1731 (set-marker (car p) nil))
1410 (setq deactivate-mark nil) 1732 (setq deactivate-mark nil)
1411 ))) 1733 )))
1412 1734
1413 1735
1414 1736
1415(defun rst-display-decorations-hierarchy (&optional decorations) 1737(defun rst-display-adornments-hierarchy (&optional adornments)
1416 "Display the current file's section title decorations hierarchy. 1738 "Display the current file's section title adornments hierarchy.
1417This function expects a list of (char, style, indent) triples in 1739This function expects a list of (CHARACTER STYLE INDENT) triples
1418DECORATIONS." 1740in ADORNMENTS."
1419 (interactive) 1741 (interactive)
1420 1742 (rst-reset-section-caches)
1421 (if (not decorations) 1743 (if (not adornments)
1422 (setq decorations (rst-get-hierarchy))) 1744 (setq adornments (rst-get-hierarchy)))
1423 (with-output-to-temp-buffer "*rest section hierarchy*" 1745 (with-output-to-temp-buffer "*rest section hierarchy*"
1424 (let ((level 1)) 1746 (let ((level 1))
1425 (with-current-buffer standard-output 1747 (with-current-buffer standard-output
1426 (dolist (x decorations) 1748 (dolist (x adornments)
1427 (insert (format "\nSection Level %d" level)) 1749 (insert (format "\nSection Level %d" level))
1428 (apply 'rst-update-section x) 1750 (apply 'rst-update-section x)
1429 (goto-char (point-max)) 1751 (goto-char (point-max))
@@ -1437,32 +1759,30 @@ DECORATIONS."
1437 (let ((tail (member elem list))) 1759 (let ((tail (member elem list)))
1438 (if tail (- (length list) (length tail))))) 1760 (if tail (- (length list) (length tail)))))
1439 1761
1440(defun rst-straighten-decorations () 1762(defun rst-straighten-adornments ()
1441 "Redo all the decorations in the current buffer. 1763 "Redo all the adornments in the current buffer.
1442This is done using our preferred set of decorations. This can be 1764This is done using our preferred set of adornments. This can be
1443used, for example, when using somebody else's copy of a document, 1765used, for example, when using somebody else's copy of a document,
1444in order to adapt it to our preferred style." 1766in order to adapt it to our preferred style."
1445 (interactive) 1767 (interactive)
1768 (rst-reset-section-caches)
1446 (save-excursion 1769 (save-excursion
1447 (let* ((alldecos (rst-find-all-decorations)) 1770 (let (;; Get a list of pairs of (level . marker)
1448 (hier (rst-get-hierarchy alldecos)) 1771 (levels-and-markers (mapcar
1449 1772 (lambda (ado)
1450 ;; Get a list of pairs of (level . marker) 1773 (cons (rst-position (cdr ado)
1451 (levels-and-markers (mapcar 1774 (rst-get-hierarchy))
1452 (lambda (deco) 1775 (progn
1453 (cons (rst-position (cdr deco) hier) 1776 (goto-char (point-min))
1454 (progn 1777 (forward-line (1- (car ado)))
1455 (goto-char (point-min)) 1778 (point-marker))))
1456 (forward-line (1- (car deco))) 1779 (rst-find-all-adornments))))
1457 (point-marker))))
1458 alldecos))
1459 )
1460 (dolist (lm levels-and-markers) 1780 (dolist (lm levels-and-markers)
1461 ;; Go to the appropriate position 1781 ;; Go to the appropriate position
1462 (goto-char (cdr lm)) 1782 (goto-char (cdr lm))
1463 1783
1464 ;; Apply the new styule 1784 ;; Apply the new styule
1465 (apply 'rst-update-section (nth (car lm) rst-preferred-decorations)) 1785 (apply 'rst-update-section (nth (car lm) rst-preferred-adornments))
1466 1786
1467 ;; Reset the market to avoid slowing down editing until it gets GC'ed 1787 ;; Reset the market to avoid slowing down editing until it gets GC'ed
1468 (set-marker (cdr lm) nil) 1788 (set-marker (cdr lm) nil)
@@ -1470,71 +1790,257 @@ in order to adapt it to our preferred style."
1470 ))) 1790 )))
1471 1791
1472 1792
1473 1793
1474 1794;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1475(defun rst-straighten-deco-spacing () 1795;; Insert list items
1476 "Adjust the spacing before and after decorations in the entire document. 1796;; =================
1477The spacing will be set to two blank lines before the first two 1797
1478section levels, and one blank line before any of the other 1798
1479section levels." 1799;=================================================
1480;; FIXME: we need to take care of subtitle at some point. 1800; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <wence@gmx.li>
1481 (interactive) 1801; I needed to make some tiny changes to the functions, so I put it here.
1482 (save-excursion 1802; -- Wei-Wei Guo
1483 (let* ((alldecos (rst-find-all-decorations))) 1803
1484 1804(defconst rst-arabic-to-roman
1485 ;; Work the list from the end, so that we don't have to use markers to 1805 '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD")
1486 ;; adjust for the changes in the document. 1806 (100 . "C") (90 . "XC") (50 . "L") (40 . "XL")
1487 (dolist (deco (nreverse alldecos)) 1807 (10 . "X") (9 . "IX") (5 . "V") (4 . "IV")
1488 ;; Go to the appropriate position. 1808 (1 . "I"))
1489 (goto-char (point-min)) 1809 "List of maps between Arabic numbers and their Roman numeral equivalents.")
1490 (forward-line (1- (car deco))) 1810
1491 (insert "@\n") 1811(defun rst-arabic-to-roman (num &optional arg)
1492;; FIXME: todo, we 1812 "Convert Arabic number NUM to its Roman numeral representation.
1493 ) 1813
1494 ))) 1814Obviously, NUM must be greater than zero. Don't blame me, blame the
1495 1815Romans, I mean \"what have the Romans ever _done_ for /us/?\" (with
1816apologies to Monty Python).
1817If optional prefix ARG is non-nil, insert in current buffer."
1818 (let ((map rst-arabic-to-roman)
1819 res)
1820 (while (and map (> num 0))
1821 (if (or (= num (caar map))
1822 (> num (caar map)))
1823 (setq res (concat res (cdar map))
1824 num (- num (caar map)))
1825 (setq map (cdr map))))
1826 res))
1827
1828(defun rst-roman-to-arabic (string &optional arg)
1829 "Convert STRING of Roman numerals to an Arabic number.
1830
1831If STRING contains a letter which isn't a valid Roman numeral, the rest
1832of the string from that point onwards is ignored.
1833
1834Hence:
1835MMD == 2500
1836and
1837MMDFLXXVI == 2500.
1838If optional ARG is non-nil, insert in current buffer."
1839 (let ((res 0)
1840 (map rst-arabic-to-roman))
1841 (while map
1842 (if (string-match (concat "^" (cdar map)) string)
1843 (setq res (+ res (caar map))
1844 string (replace-match "" nil t string))
1845 (setq map (cdr map))))
1846 res))
1847;=================================================
1496 1848
1497(defun rst-find-pfx-in-region (beg end pfx-re) 1849(defun rst-find-pfx-in-region (beg end pfx-re)
1498 "Find all the positions of prefixes in region between BEG and END. 1850 "Find all the positions of prefixes in region between BEG and END.
1499This is used to find bullets and enumerated list items. PFX-RE 1851This is used to find bullets and enumerated list items. PFX-RE is
1500is a regular expression for matching the lines with items." 1852a regular expression for matching the lines after indentation
1853with items. Returns a list of cons cells consisting of the point
1854and the column of the point."
1501 (let ((pfx ())) 1855 (let ((pfx ()))
1502 (save-excursion 1856 (save-excursion
1503 (goto-char beg) 1857 (goto-char beg)
1504 (while (< (point) end) 1858 (while (< (point) end)
1505 (back-to-indentation) 1859 (back-to-indentation)
1506 (when (and 1860 (when (and
1507 (looking-at pfx-re) 1861 (looking-at pfx-re) ; pfx found and...
1508 (let ((pfx-col (current-column))) 1862 (let ((pfx-col (current-column)))
1509 (save-excursion 1863 (save-excursion
1510 (forward-line -1) 1864 (forward-line -1) ; ...previous line is...
1511 (back-to-indentation) 1865 (back-to-indentation)
1512 (or (looking-at "^[ \t]*$") 1866 (or (looking-at (rst-re 'lin-end)) ; ...empty,
1513 (> (current-column) pfx-col) 1867 (> (current-column) pfx-col) ; ...deeper level, or
1514 (and (= (current-column) pfx-col) 1868 (and (= (current-column) pfx-col)
1515 (looking-at pfx-re)))))) 1869 (looking-at pfx-re)))))) ; ...pfx at same level
1516 (push (cons (point) (current-column)) 1870 (push (cons (point) (current-column))
1517 pfx)) 1871 pfx))
1518 (forward-line 1)) ) 1872 (forward-line 1)) )
1519 (nreverse pfx))) 1873 (nreverse pfx)))
1520 1874
1521(defvar rst-re-bullets 1875(defun rst-insert-list-pos (newitem)
1522 (format "\\([%s][ \t]\\)[^ \t]" (regexp-quote (concat rst-bullets))) 1876 "Arrange relative position of a newly inserted list item.
1523 "Regexp for finding bullets.") 1877
1878Adding a new list might consider three situations:
1524 1879
1525;; (defvar rst-re-enumerations 1880 (a) Current line is a blank line.
1526;; "\\(\\(#\\|[0-9]+\\)\\.[ \t]\\)[^ \t]" 1881 (b) Previous line is a blank line.
1527;; "Regexp for finding bullets.") 1882 (c) Following line is a blank line.
1528 1883
1529(defvar rst-re-items 1884When (a) and (b), just add the new list at current line.
1530 (format "\\(%s\\|%s\\)[^ \t]"
1531 (format "[%s][ \t]" (regexp-quote (concat rst-bullets)))
1532 "\\(#\\|[0-9]+\\)\\.[ \t]")
1533 "Regexp for finding bullets.")
1534 1885
1535(defvar rst-preferred-bullets 1886when (a) and not (b), a blank line is added before adding the new list.
1536 '(?- ?* ?+) 1887
1537 "List of favorite bullets to set for straightening bullets.") 1888When not (a), first forward point to the end of the line, and add two
1889blank lines, then add the new list.
1890
1891Other situations are just ignored and left to users themselves."
1892 (if (save-excursion
1893 (beginning-of-line)
1894 (looking-at (rst-re 'lin-end)))
1895 (if (save-excursion
1896 (forward-line -1)
1897 (looking-at (rst-re 'lin-end)))
1898 (insert newitem " ")
1899 (insert "\n" newitem " "))
1900 (end-of-line)
1901 (insert "\n\n" newitem " ")))
1902
1903(defvar rst-initial-enums
1904 (let (vals)
1905 (dolist (fmt '("%s." "(%s)" "%s)"))
1906 (dolist (c '("1" "a" "A" "I" "i"))
1907 (push (format fmt c) vals)))
1908 (cons "#." (nreverse vals)))
1909 "List of initial enumerations.")
1910
1911(defvar rst-initial-items
1912 (append (mapcar 'char-to-string rst-bullets) rst-initial-enums)
1913 "List of initial items. It's collection of bullets and enumerations.")
1914
1915(defun rst-insert-list-new-item ()
1916 "Insert a new list item.
1917
1918User is asked to select the item style first, for example (a), i), +. Use TAB
1919for completition and choices.
1920
1921If user selects bullets or #, it's just added with position arranged by
1922`rst-insert-list-pos'.
1923
1924If user selects enumerations, a further prompt is given. User need to input a
1925starting item, for example 'e' for 'A)' style. The position is also arranged by
1926`rst-insert-list-pos'."
1927 (interactive)
1928 ;; FIXME: Make this comply to `interactive' standards
1929 (let* ((itemstyle (completing-read
1930 "Select preferred item style [#.]: "
1931 rst-initial-items nil t nil nil "#."))
1932 (cnt (if (string-match (rst-re 'cntexp-tag) itemstyle)
1933 (match-string 0 itemstyle)))
1934 (no
1935 (save-match-data
1936 ;; FIXME: Make this comply to `interactive' standards
1937 (cond
1938 ((equal cnt "a")
1939 (let ((itemno (read-string "Give starting value [a]: "
1940 nil nil "a")))
1941 (downcase (substring itemno 0 1))))
1942 ((equal cnt "A")
1943 (let ((itemno (read-string "Give starting value [A]: "
1944 nil nil "A")))
1945 (upcase (substring itemno 0 1))))
1946 ((equal cnt "I")
1947 (let ((itemno (read-number "Give starting value [1]: " 1)))
1948 (rst-arabic-to-roman itemno)))
1949 ((equal cnt "i")
1950 (let ((itemno (read-number "Give starting value [1]: " 1)))
1951 (downcase (rst-arabic-to-roman itemno))))
1952 ((equal cnt "1")
1953 (let ((itemno (read-number "Give starting value [1]: " 1)))
1954 (number-to-string itemno)))))))
1955 (if no
1956 (setq itemstyle (replace-match no t t itemstyle)))
1957 (rst-insert-list-pos itemstyle)))
1958
1959(defcustom rst-preferred-bullets
1960 '(?* ?- ?+)
1961 "List of favorite bullets."
1962 :group 'rst
1963 :type `(repeat
1964 (choice ,@(mapcar (lambda (char)
1965 (list 'const
1966 :tag (char-to-string char) char))
1967 rst-bullets)))
1968 :package-version '(rst . "1.1.0"))
1969
1970(defun rst-insert-list-continue (curitem prefer-roman)
1971 "Insert a list item with list start CURITEM including its indentation level."
1972 (end-of-line)
1973 (insert
1974 "\n" ; FIXME: Separating lines must be possible
1975 (cond
1976 ((string-match (rst-re '(:alt enmaut-tag
1977 bul-tag)) curitem)
1978 curitem)
1979 ((string-match (rst-re 'num-tag) curitem)
1980 (replace-match (number-to-string
1981 (1+ (string-to-number (match-string 0 curitem))))
1982 nil nil curitem))
1983 ((and (string-match (rst-re 'rom-tag) curitem)
1984 (save-match-data
1985 (if (string-match (rst-re 'ltr-tag) curitem) ; Also a letter tag
1986 (save-excursion
1987 ;; FIXME: Assumes one line list items without separating
1988 ;; empty lines
1989 (if (and (zerop (forward-line -1))
1990 (looking-at (rst-re 'enmexp-beg)))
1991 (string-match
1992 (rst-re 'rom-tag)
1993 (match-string 0)) ; Previous was a roman tag
1994 prefer-roman)) ; Don't know - use flag
1995 t))) ; Not a letter tag
1996 (replace-match
1997 (let* ((old (match-string 0 curitem))
1998 (new (save-match-data
1999 (rst-arabic-to-roman
2000 (1+ (rst-roman-to-arabic
2001 (upcase old)))))))
2002 (if (equal old (upcase old))
2003 (upcase new)
2004 (downcase new)))
2005 t nil curitem))
2006 ((string-match (rst-re 'ltr-tag) curitem)
2007 (replace-match (char-to-string
2008 (1+ (string-to-char (match-string 0 curitem))))
2009 nil nil curitem)))))
2010
2011
2012(defun rst-insert-list (&optional prefer-roman)
2013 "Insert a list item at the current point.
2014
2015The command can insert a new list or a continuing list. When it is called at a
2016non-list line, it will promote to insert new list. When it is called at a list
2017line, it will insert a list with the same list style.
2018
20191. When inserting a new list:
2020
2021User is asked to select the item style first, for example (a), i), +. Use TAB
2022for completition and choices.
2023
2024 (a) If user selects bullets or #, it's just added.
2025 (b) If user selects enumerations, a further prompt is given. User needs to
2026 input a starting item, for example 'e' for 'A)' style.
2027
2028The position of the new list is arranged according to whether or not the
2029current line and the previous line are blank lines.
2030
20312. When continuing a list, one thing need to be noticed:
2032
2033List style alphabetical list, such as 'a.', and roman numerical list, such as
2034'i.', have some overlapping items, for example 'v.' The function can deal with
2035the problem elegantly in most situations. But when those overlapped list are
2036preceded by a blank line, it is hard to determine which type to use
2037automatically. The function uses alphabetical list by default. If you want
2038roman numerical list, just use a prefix (\\[universal-argument])."
2039 (interactive "P")
2040 (beginning-of-line)
2041 (if (looking-at (rst-re 'itmany-beg-1))
2042 (rst-insert-list-continue (match-string 0) prefer-roman)
2043 (rst-insert-list-new-item)))
1538 2044
1539(defun rst-straighten-bullets-region (beg end) 2045(defun rst-straighten-bullets-region (beg end)
1540 "Make all the bulleted list items in the region consistent. 2046 "Make all the bulleted list items in the region consistent.
@@ -1547,8 +2053,7 @@ adjust. If bullets are found on levels beyond the
1547`rst-preferred-bullets' list, they are not modified." 2053`rst-preferred-bullets' list, they are not modified."
1548 (interactive "r") 2054 (interactive "r")
1549 2055
1550 (let ((bullets (rst-find-pfx-in-region beg end 2056 (let ((bullets (rst-find-pfx-in-region beg end (rst-re 'bul-sta)))
1551 rst-re-bullets))
1552 (levtable (make-hash-table :size 4))) 2057 (levtable (make-hash-table :size 4)))
1553 2058
1554 ;; Create a map of levels to list of positions. 2059 ;; Create a map of levels to list of positions.
@@ -1573,25 +2078,25 @@ adjust. If bullets are found on levels beyond the
1573 (insert (string (car bullets)))) 2078 (insert (string (car bullets))))
1574 (setq bullets (cdr bullets)))))))) 2079 (setq bullets (cdr bullets))))))))
1575 2080
1576(defun rst-rstrip (str) 2081
1577 "Strips the whitespace at the end of string STR." 2082;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1578 (string-match "[ \t\n]*\\'" str) 2083;; Table of contents
1579 (substring str 0 (match-beginning 0))) 2084;; =================
1580 2085
1581(defun rst-get-stripped-line () 2086(defun rst-get-stripped-line ()
1582 "Return the line at cursor, stripped from whitespace." 2087 "Return the line at cursor, stripped from whitespace."
1583 (re-search-forward "\\S-.*\\S-" (line-end-position)) 2088 (re-search-forward (rst-re "\\S .*\\S ") (line-end-position))
1584 (buffer-substring-no-properties (match-beginning 0) 2089 (buffer-substring-no-properties (match-beginning 0)
1585 (match-end 0)) ) 2090 (match-end 0)) )
1586 2091
1587(defun rst-section-tree (alldecos) 2092(defun rst-section-tree ()
1588 "Get the hierarchical tree of section titles. 2093 "Get the hierarchical tree of section titles.
1589 2094
1590Returns a hierarchical tree of the sections titles in the 2095Returns a hierarchical tree of the sections titles in the
1591document, for decorations ALLDECOS. This can be used to generate 2096document. This can be used to generate a table of contents for
1592a table of contents for the document. The top node will always 2097the document. The top node will always be a nil node, with the
1593be a nil node, with the top level titles as children (there may 2098top level titles as children (there may potentially be more than
1594potentially be more than one). 2099one).
1595 2100
1596Each section title consists in a cons of the stripped title 2101Each section title consists in a cons of the stripped title
1597string and a marker to the section in the original text document. 2102string and a marker to the section in the original text document.
@@ -1603,57 +2108,56 @@ Conceptually, the nil nodes--i.e. those which have no title--are
1603to be considered as being the same line as their first non-nil 2108to be considered as being the same line as their first non-nil
1604child. This has advantages later in processing the graph." 2109child. This has advantages later in processing the graph."
1605 2110
1606 (let* ((hier (rst-get-hierarchy alldecos)) 2111 (let ((hier (rst-get-hierarchy))
1607 (levels (make-hash-table :test 'equal :size 10)) 2112 (levels (make-hash-table :test 'equal :size 10))
1608 lines) 2113 lines)
1609 2114
1610 (let ((lev 0)) 2115 (let ((lev 0))
1611 (dolist (deco hier) 2116 (dolist (ado hier)
1612 ;; Compare just the character and indent in the hash table. 2117 ;; Compare just the character and indent in the hash table.
1613 (puthash (cons (car deco) (cadr deco)) lev levels) 2118 (puthash (cons (car ado) (cadr ado)) lev levels)
1614 (incf lev))) 2119 (incf lev)))
1615 2120
1616 ;; Create a list of lines that contains (text, level, marker) for each 2121 ;; Create a list of lines that contains (text, level, marker) for each
1617 ;; decoration. 2122 ;; adornment.
1618 (save-excursion 2123 (save-excursion
1619 (setq lines 2124 (setq lines
1620 (mapcar (lambda (deco) 2125 (mapcar (lambda (ado)
1621 (goto-char (point-min)) 2126 (goto-char (point-min))
1622 (forward-line (1- (car deco))) 2127 (forward-line (1- (car ado)))
1623 (list (gethash (cons (cadr deco) (caddr deco)) levels) 2128 (list (gethash (cons (cadr ado) (caddr ado)) levels)
1624 (rst-get-stripped-line) 2129 (rst-get-stripped-line)
1625 (progn 2130 (progn
1626 (beginning-of-line 1) 2131 (beginning-of-line 1)
1627 (point-marker)))) 2132 (point-marker))))
1628 alldecos))) 2133 (rst-find-all-adornments))))
1629
1630 (let ((lcontnr (cons nil lines))) 2134 (let ((lcontnr (cons nil lines)))
1631 (rst-section-tree-rec lcontnr -1)))) 2135 (rst-section-tree-rec lcontnr -1))))
1632 2136
1633 2137
1634(defun rst-section-tree-rec (decos lev) 2138(defun rst-section-tree-rec (ados lev)
1635 "Recursive guts of the section tree construction. 2139 "Recursive guts of the section tree construction.
1636DECOS is a cons cell whose cdr is the remaining list of 2140ADOS is a cons cell whose cdr is the remaining list of
1637decorations, and we change it as we consume them. LEV is 2141adornments, and we change it as we consume them. LEV is
1638the current level of that node. This function returns a 2142the current level of that node. This function returns a
1639pair of the subtree that was built. This treats the DECOS 2143pair of the subtree that was built. This treats the ADOS
1640list destructively." 2144list destructively."
1641 2145
1642 (let ((ndeco (cadr decos)) 2146 (let ((nado (cadr ados))
1643 node 2147 node
1644 children) 2148 children)
1645 2149
1646 ;; If the next decoration matches our level 2150 ;; If the next adornment matches our level
1647 (when (and ndeco (= (car ndeco) lev)) 2151 (when (and nado (= (car nado) lev))
1648 ;; Pop the next decoration and create the current node with it 2152 ;; Pop the next adornment and create the current node with it
1649 (setcdr decos (cddr decos)) 2153 (setcdr ados (cddr ados))
1650 (setq node (cdr ndeco)) ) 2154 (setq node (cdr nado)) )
1651 ;; Else we let the node title/marker be unset. 2155 ;; Else we let the node title/marker be unset.
1652 2156
1653 ;; Build the child nodes 2157 ;; Build the child nodes
1654 (while (and (cdr decos) (> (caadr decos) lev)) 2158 (while (and (cdr ados) (> (caadr ados) lev))
1655 (setq children 2159 (setq children
1656 (cons (rst-section-tree-rec decos (1+ lev)) 2160 (cons (rst-section-tree-rec ados (1+ lev))
1657 children))) 2161 children)))
1658 (setq children (reverse children)) 2162 (setq children (reverse children))
1659 2163
@@ -1749,9 +2253,8 @@ If a numeric prefix argument PFXARG is given, insert the TOC up
1749to the specified level. 2253to the specified level.
1750 2254
1751The TOC is inserted indented at the current column." 2255The TOC is inserted indented at the current column."
1752
1753 (interactive "P") 2256 (interactive "P")
1754 2257 (rst-reset-section-caches)
1755 (let* (;; Check maximum level override 2258 (let* (;; Check maximum level override
1756 (rst-toc-insert-max-level 2259 (rst-toc-insert-max-level
1757 (if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0)) 2260 (if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0))
@@ -1760,7 +2263,7 @@ The TOC is inserted indented at the current column."
1760 ;; Get the section tree for the current cursor point. 2263 ;; Get the section tree for the current cursor point.
1761 (sectree-pair 2264 (sectree-pair
1762 (rst-section-tree-point 2265 (rst-section-tree-point
1763 (rst-section-tree (rst-find-all-decorations)))) 2266 (rst-section-tree)))
1764 2267
1765 ;; Figure out initial indent. 2268 ;; Figure out initial indent.
1766 (initial-indent (make-string (current-column) ? )) 2269 (initial-indent (make-string (current-column) ? ))
@@ -1830,8 +2333,9 @@ level to align."
1830 (if do-child-numbering 2333 (if do-child-numbering
1831 (progn 2334 (progn
1832 ;; Add a separating dot if there is already a prefix 2335 ;; Add a separating dot if there is already a prefix
1833 (if (> (length pfx) 0) 2336 (when (> (length pfx) 0)
1834 (setq pfx (concat (rst-rstrip pfx) "."))) 2337 (string-match (rst-re "[ \t\n]*\\'") pfx)
2338 (setq pfx (concat (replace-match "" t t pfx) ".")))
1835 2339
1836 ;; Calculate the amount of space that the prefix will require 2340 ;; Calculate the amount of space that the prefix will require
1837 ;; for the numbers. 2341 ;; for the numbers.
@@ -1852,59 +2356,48 @@ level to align."
1852 ))) 2356 )))
1853 2357
1854 2358
1855(defun rst-toc-insert-find-delete-contents ()
1856 "Find and delete an existing comment after the first contents directive.
1857Delete that region. Return t if found and the cursor is left after the comment."
1858 (goto-char (point-min))
1859 ;; We look for the following and the following only (in other words, if your
1860 ;; syntax differs, this won't work. If you would like a more flexible thing,
1861 ;; contact the author, I just can't imagine that this requirement is
1862 ;; unreasonable for now).
1863 ;;
1864 ;; .. contents:: [...anything here...]
1865 ;; ..
1866 ;; XXXXXXXX
1867 ;; XXXXXXXX
1868 ;; [more lines]
1869 ;;
1870 (let ((beg
1871 (re-search-forward "^\\.\\. contents[ \t]*::\\(.*\\)\n\\.\\."
1872 nil t))
1873 last-real)
1874 (when beg
1875 ;; Look for the first line that starts at the first column.
1876 (forward-line 1)
1877 (beginning-of-line)
1878 (while (and
1879 (< (point) (point-max))
1880 (or (and (looking-at "[ \t]+[^ \t]") (setq last-real (point)) t)
1881 (looking-at "[ \t]*$")))
1882 (forward-line 1)
1883 )
1884 (if last-real
1885 (progn
1886 (goto-char last-real)
1887 (end-of-line)
1888 (delete-region beg (point)))
1889 (goto-char beg))
1890 t
1891 )))
1892
1893(defun rst-toc-update () 2359(defun rst-toc-update ()
1894 "Automatically find the contents section of a document and update. 2360 "Automatically find the contents section of a document and update.
1895Updates the inserted TOC if present. You can use this in your 2361Updates the inserted TOC if present. You can use this in your
1896file-write hook to always make it up-to-date automatically." 2362file-write hook to always make it up-to-date automatically."
1897 (interactive) 2363 (interactive)
1898 (let ((p (point))) 2364 (save-excursion
1899 (save-excursion 2365 ;; Find and delete an existing comment after the first contents directive.
1900 (when (rst-toc-insert-find-delete-contents) 2366 ;; Delete that region.
1901 (insert "\n ") 2367 (goto-char (point-min))
1902 (rst-toc-insert) 2368 ;; We look for the following and the following only (in other words, if your
1903 )) 2369 ;; syntax differs, this won't work.).
1904 ;; Somehow save-excursion does not really work well. 2370 ;;
1905 (goto-char p)) 2371 ;; .. contents:: [...anything here...]
2372 ;; [:field: value]...
2373 ;; ..
2374 ;; XXXXXXXX
2375 ;; XXXXXXXX
2376 ;; [more lines]
2377 (let ((beg (re-search-forward
2378 (rst-re "^" 'exm-sta "contents" 'dcl-tag ".*\n"
2379 "\\(?:" 'hws-sta 'fld-tag ".*\n\\)*" 'exm-tag) nil t))
2380 last-real)
2381 (when beg
2382 ;; Look for the first line that starts at the first column.
2383 (forward-line 1)
2384 (while (and
2385 (< (point) (point-max))
2386 (or (if (looking-at
2387 (rst-re 'hws-sta "\\S ")) ; indented content
2388 (setq last-real (point)))
2389 (looking-at (rst-re 'lin-end)))) ; empty line
2390 (forward-line 1))
2391 (if last-real
2392 (progn
2393 (goto-char last-real)
2394 (end-of-line)
2395 (delete-region beg (point)))
2396 (goto-char beg))
2397 (insert "\n ")
2398 (rst-toc-insert))))
1906 ;; Note: always return nil, because this may be used as a hook. 2399 ;; Note: always return nil, because this may be used as a hook.
1907 ) 2400 nil)
1908 2401
1909;; Note: we cannot bind the TOC update on file write because it messes with 2402;; Note: we cannot bind the TOC update on file write because it messes with
1910;; undo. If we disable undo, since it adds and removes characters, the 2403;; undo. If we disable undo, since it adds and removes characters, the
@@ -1916,7 +2409,7 @@ file-write hook to always make it up-to-date automatically."
1916;; ;; Disable undo for the write file hook. 2409;; ;; Disable undo for the write file hook.
1917;; (let ((buffer-undo-list t)) (rst-toc-update) )) 2410;; (let ((buffer-undo-list t)) (rst-toc-update) ))
1918 2411
1919(defalias 'rst-toc-insert-update 'rst-toc-update) ;; backwards compat. 2412(defalias 'rst-toc-insert-update 'rst-toc-update) ; backwards compat.
1920 2413
1921;;------------------------------------------------------------------------------ 2414;;------------------------------------------------------------------------------
1922 2415
@@ -1962,13 +2455,13 @@ children, and t if the node has been found."
1962(defvar rst-toc-buffer-name "*Table of Contents*" 2455(defvar rst-toc-buffer-name "*Table of Contents*"
1963 "Name of the Table of Contents buffer.") 2456 "Name of the Table of Contents buffer.")
1964 2457
1965(defvar rst-toc-return-buffer nil 2458(defvar rst-toc-return-wincfg nil
1966 "Buffer to which to return when leaving the TOC.") 2459 "Window configuration to which to return when leaving the TOC.")
1967 2460
1968 2461
1969(defun rst-toc () 2462(defun rst-toc ()
1970 "Display a table-of-contents. 2463 "Display a table-of-contents.
1971Finds all the section titles and their decorations in the 2464Finds all the section titles and their adornments in the
1972file, and displays a hierarchically-organized list of the 2465file, and displays a hierarchically-organized list of the
1973titles, which is essentially a table-of-contents of the 2466titles, which is essentially a table-of-contents of the
1974document. 2467document.
@@ -1976,11 +2469,9 @@ document.
1976The Emacs buffer can be navigated, and selecting a section 2469The Emacs buffer can be navigated, and selecting a section
1977brings the cursor in that section." 2470brings the cursor in that section."
1978 (interactive) 2471 (interactive)
1979 (let* ((curbuf (current-buffer)) 2472 (rst-reset-section-caches)
1980 2473 (let* ((curbuf (list (current-window-configuration) (point-marker)))
1981 ;; Get the section tree 2474 (sectree (rst-section-tree))
1982 (alldecos (rst-find-all-decorations))
1983 (sectree (rst-section-tree alldecos))
1984 2475
1985 (our-node (cdr (rst-section-tree-point sectree))) 2476 (our-node (cdr (rst-section-tree-point sectree)))
1986 line 2477 line
@@ -2006,7 +2497,7 @@ brings the cursor in that section."
2006 (pop-to-buffer buf) 2497 (pop-to-buffer buf)
2007 2498
2008 ;; Save the buffer to return to. 2499 ;; Save the buffer to return to.
2009 (set (make-local-variable 'rst-toc-return-buffer) curbuf) 2500 (set (make-local-variable 'rst-toc-return-wincfg) curbuf)
2010 2501
2011 ;; Move the cursor near the right section in the TOC. 2502 ;; Move the cursor near the right section in the TOC.
2012 (goto-char (point-min)) 2503 (goto-char (point-min))
@@ -2023,11 +2514,15 @@ brings the cursor in that section."
2023 (error "Buffer for this section was killed")) 2514 (error "Buffer for this section was killed"))
2024 pos)) 2515 pos))
2025 2516
2517;; FIXME: Cursor before or behind the list must be handled properly; before the
2518;; list should jump to the top and behind the list to the last normal
2519;; paragraph
2026(defun rst-goto-section (&optional kill) 2520(defun rst-goto-section (&optional kill)
2027 "Go to the section the current line describes." 2521 "Go to the section the current line describes."
2028 (interactive) 2522 (interactive)
2029 (let ((pos (rst-toc-mode-find-section))) 2523 (let ((pos (rst-toc-mode-find-section)))
2030 (when kill 2524 (when kill
2525 (set-window-configuration (car rst-toc-return-wincfg))
2031 (kill-buffer (get-buffer rst-toc-buffer-name))) 2526 (kill-buffer (get-buffer rst-toc-buffer-name)))
2032 (pop-to-buffer (marker-buffer pos)) 2527 (pop-to-buffer (marker-buffer pos))
2033 (goto-char pos) 2528 (goto-char pos)
@@ -2044,9 +2539,9 @@ brings the cursor in that section."
2044EVENT is the input event." 2539EVENT is the input event."
2045 (interactive "e") 2540 (interactive "e")
2046 (let ((pos 2541 (let ((pos
2047 (with-current-buffer (window-buffer (posn-window (event-end event))) 2542 (with-current-buffer (window-buffer (posn-window (event-end event)))
2048 (save-excursion 2543 (save-excursion
2049 (goto-char (posn-point (event-end event))) 2544 (goto-char (posn-point (event-end event)))
2050 (rst-toc-mode-find-section))))) 2545 (rst-toc-mode-find-section)))))
2051 (pop-to-buffer (marker-buffer pos)) 2546 (pop-to-buffer (marker-buffer pos))
2052 (goto-char pos) 2547 (goto-char pos)
@@ -2061,8 +2556,9 @@ EVENT is the input event."
2061(defun rst-toc-quit-window () 2556(defun rst-toc-quit-window ()
2062 "Leave the current TOC buffer." 2557 "Leave the current TOC buffer."
2063 (interactive) 2558 (interactive)
2064 (quit-window) 2559 (let ((retbuf rst-toc-return-wincfg))
2065 (pop-to-buffer rst-toc-return-buffer)) 2560 (set-window-configuration (car retbuf))
2561 (goto-char (cadr retbuf))))
2066 2562
2067(defvar rst-toc-mode-map 2563(defvar rst-toc-mode-map
2068 (let ((map (make-sparse-keymap))) 2564 (let ((map (make-sparse-keymap)))
@@ -2087,40 +2583,40 @@ EVENT is the input event."
2087 2583
2088 2584
2089;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2585;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2090;; 2586;; Section movement commands
2091;; Section movement commands. 2587;; =========================
2092;;
2093 2588
2094(defun rst-forward-section (&optional offset) 2589(defun rst-forward-section (&optional offset)
2095 "Skip to the next restructured text section title. 2590 "Skip to the next reStructuredText section title.
2096OFFSET specifies how many titles to skip. Use a negative OFFSET to move 2591OFFSET specifies how many titles to skip. Use a negative OFFSET to move
2097backwards in the file (default is to use 1)." 2592backwards in the file (default is to use 1)."
2098 (interactive) 2593 (interactive)
2594 (rst-reset-section-caches)
2099 (let* (;; Default value for offset. 2595 (let* (;; Default value for offset.
2100 (offset (or offset 1)) 2596 (offset (or offset 1))
2101 2597
2102 ;; Get all the decorations in the file, with their line numbers. 2598 ;; Get all the adornments in the file, with their line numbers.
2103 (alldecos (rst-find-all-decorations)) 2599 (allados (rst-find-all-adornments))
2104 2600
2105 ;; Get the current line. 2601 ;; Get the current line.
2106 (curline (line-number-at-pos)) 2602 (curline (line-number-at-pos))
2107 2603
2108 (cur alldecos) 2604 (cur allados)
2109 (idx 0) 2605 (idx 0)
2110 ) 2606 )
2111 2607
2112 ;; Find the index of the "next" decoration w.r.t. to the current line. 2608 ;; Find the index of the "next" adornment w.r.t. to the current line.
2113 (while (and cur (< (caar cur) curline)) 2609 (while (and cur (< (caar cur) curline))
2114 (setq cur (cdr cur)) 2610 (setq cur (cdr cur))
2115 (incf idx)) 2611 (incf idx))
2116 ;; 'cur' is the decoration on or following the current line. 2612 ;; 'cur' is the adornment on or following the current line.
2117 2613
2118 (if (and (> offset 0) cur (= (caar cur) curline)) 2614 (if (and (> offset 0) cur (= (caar cur) curline))
2119 (incf idx)) 2615 (incf idx))
2120 2616
2121 ;; Find the final index. 2617 ;; Find the final index.
2122 (setq idx (+ idx (if (> offset 0) (- offset 1) offset))) 2618 (setq idx (+ idx (if (> offset 0) (- offset 1) offset)))
2123 (setq cur (nth idx alldecos)) 2619 (setq cur (nth idx allados))
2124 2620
2125 ;; If the index is positive, goto the line, otherwise go to the buffer 2621 ;; If the index is positive, goto the line, otherwise go to the buffer
2126 ;; boundaries. 2622 ;; boundaries.
@@ -2156,245 +2652,25 @@ backwards in the file (default is to use 1)."
2156 (push-mark nil t t) 2652 (push-mark nil t t)
2157 (rst-forward-section (- arg))))) 2653 (rst-forward-section (- arg)))))
2158 2654
2159
2160
2161
2162
2163 2655
2164;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2656;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2165;; Functions to work on item lists (e.g. indent/dedent, enumerate), which are 2657;; Functions to work on item lists (e.g. indent/dedent, enumerate), which are
2166;; always 2 or 3 characters apart horizontally with rest. 2658;; always 2 or 3 characters apart horizontally with rest.
2167 2659
2168;; (FIXME: there is currently a bug that makes the region go away when we do that.)
2169(defvar rst-shift-fill-region nil
2170 "If non-nil, automatically re-fill the region that is being shifted.")
2171
2172(defun rst-find-leftmost-column (beg end) 2660(defun rst-find-leftmost-column (beg end)
2173 "Find the leftmost column in the region." 2661 "Return the leftmost column in region BEG to END."
2174 (let ((mincol 1000)) 2662 (let (mincol)
2175 (save-excursion 2663 (save-excursion
2176 (goto-char beg) 2664 (goto-char beg)
2177 (while (< (point) end) 2665 (while (< (point) end)
2178 (back-to-indentation) 2666 (back-to-indentation)
2179 (unless (looking-at "[ \t]*$") 2667 (unless (looking-at (rst-re 'lin-end))
2180 (setq mincol (min mincol (current-column)))) 2668 (setq mincol (if mincol
2181 (forward-line 1) 2669 (min mincol (current-column))
2182 )) 2670 (current-column))))
2671 (forward-line 1)))
2183 mincol)) 2672 mincol))
2184 2673
2185
2186;; What we really need to do is compute all the possible alignment possibilities
2187;; and then select one.
2188;;
2189;; .. line-block::
2190;;
2191;; a) sdjsds
2192;;
2193;; - sdjsd jsjds
2194;;
2195;; sdsdsjdsj
2196;;
2197;; 11. sjdss jddjs
2198;;
2199;; * * * * * * *
2200;;
2201;; Move backwards, accumulate the beginning positions, and also the second
2202;; positions, in case the line matches the bullet pattern, and then sort.
2203
2204(defun rst-compute-bullet-tabs (&optional pt)
2205 "Build the list of possible horizontal alignment points.
2206Search backwards from point (or point PT if specified) to
2207build the list of possible horizontal alignment points that
2208includes the beginning and contents of a restructuredtext
2209bulleted or enumerated list item. Return a sorted list
2210of (COLUMN-NUMBER . LINE) pairs."
2211 (save-excursion
2212 (when pt (goto-char pt))
2213
2214 ;; We work our way backwards and towards the left.
2215 (let ((leftcol 100000) ;; Current column.
2216 (tablist nil) ;; List of tab positions.
2217 )
2218
2219 ;; Start by skipping the current line.
2220 (beginning-of-line 0)
2221
2222 ;; Search backwards for each line.
2223 (while (and (> (point) (point-min))
2224 (> leftcol 0))
2225
2226 ;; Skip empty lines.
2227 (unless (looking-at "^[ \t]*$")
2228 ;; Inspect the current non-empty line
2229 (back-to-indentation)
2230
2231 ;; Skip lines that are beyond the current column (we want to move
2232 ;; towards the left).
2233 (let ((col (current-column)))
2234 (when (< col leftcol)
2235
2236 ;; Add the beginning of the line as a tabbing point.
2237 (unless (memq col (mapcar 'car tablist))
2238 (push (cons col (point)) tablist))
2239
2240 ;; Look at the line to figure out if it is a bulleted or enumerate
2241 ;; list item.
2242 (when (looking-at
2243 (concat
2244 "\\(?:"
2245 "\\(\\(?:[0-9a-zA-Z#]\\{1,3\\}[.):-]\\|[*+-]\\)[ \t]+\\)[^ \t\n]"
2246 "\\|"
2247 (format "\\(%s%s+[ \t]+\\)[^ \t\n]"
2248 (regexp-quote (thing-at-point 'char))
2249 (regexp-quote (thing-at-point 'char)))
2250 "\\)"
2251 ))
2252 ;; Add the column of the contained item.
2253 (let* ((matchlen (length (or (match-string 1) (match-string 2))))
2254 (newcol (+ col matchlen)))
2255 (unless (or (>= newcol leftcol)
2256 (memq (+ col matchlen) (mapcar 'car tablist)))
2257 (push (cons (+ col matchlen) (+ (point) matchlen))
2258 tablist)))
2259 )
2260
2261 (setq leftcol col)
2262 )))
2263
2264 ;; Move backwards one line.
2265 (beginning-of-line 0))
2266
2267 (sort tablist (lambda (x y) (<= (car x) (car y))))
2268 )))
2269
2270(defun rst-debug-print-tabs (tablist)
2271 "Insert a line and place special characters at the tab points in TABLIST."
2272 (beginning-of-line)
2273 (insert (concat "\n" (make-string 1000 ? ) "\n"))
2274 (beginning-of-line 0)
2275 (dolist (col tablist)
2276 (beginning-of-line)
2277 (forward-char (car col))
2278 (delete-char 1)
2279 (insert "@")
2280 ))
2281
2282(defun rst-debug-mark-found (tablist)
2283 "Insert a line and place special characters at the tab points in TABLIST."
2284 (dolist (col tablist)
2285 (when (cdr col)
2286 (goto-char (cdr col))
2287 (insert "@"))))
2288
2289
2290(defvar rst-shift-basic-offset 2
2291 "Basic horizontal shift distance when there is no preceding alignment tabs.")
2292
2293(defun rst-shift-region-guts (find-next-fun offset-fun)
2294 "(See `rst-shift-region-right' for a description)."
2295 (let* ((mbeg (copy-marker (region-beginning)))
2296 (mend (copy-marker (region-end)))
2297 (tabs (rst-compute-bullet-tabs mbeg))
2298 (leftmostcol (rst-find-leftmost-column (region-beginning) (region-end)))
2299 )
2300 ;; Add basic offset tabs at the end of the list. This is a better
2301 ;; implementation technique than hysteresis and a basic offset because it
2302 ;; insures that movement in both directions is consistently using the same
2303 ;; column positions. This makes it more predictable.
2304 (setq tabs
2305 (append tabs
2306 (mapcar (lambda (x) (cons x nil))
2307 (let ((maxcol 120)
2308 (max-lisp-eval-depth 2000))
2309 (flet ((addnum (x)
2310 (if (> x maxcol)
2311 nil
2312 (cons x (addnum
2313 (+ x rst-shift-basic-offset))))))
2314 (addnum (or (caar (last tabs)) 0))))
2315 )))
2316
2317 ;; (For debugging.)
2318 ;;; (save-excursion (goto-char mbeg) (forward-char -1) (rst-debug-print-tabs tabs))))
2319 ;;; (print tabs)
2320 ;;; (save-excursion (rst-debug-mark-found tabs))
2321
2322 ;; Apply the indent.
2323 (indent-rigidly
2324 mbeg mend
2325
2326 ;; Find the next tab after the leftmost column.
2327 (let ((tab (funcall find-next-fun tabs leftmostcol)))
2328
2329 (if tab
2330 (progn
2331 (when (cdar tab)
2332 (message "Aligned on '%s'"
2333 (save-excursion
2334 (goto-char (cdar tab))
2335 (buffer-substring-no-properties
2336 (line-beginning-position)
2337 (line-end-position))))
2338 )
2339 (- (caar tab) leftmostcol)) ;; Num chars.
2340
2341 ;; Otherwise use the basic offset
2342 (funcall offset-fun rst-shift-basic-offset)
2343 )))
2344
2345 ;; Optionally reindent.
2346 (when rst-shift-fill-region
2347 (fill-region mbeg mend))
2348 ))
2349
2350(defun rst-shift-region-right (pfxarg)
2351 "Indent region rigidly, by a few characters to the right.
2352This function first computes all possible alignment columns by
2353inspecting the lines preceding the region for bulleted or
2354enumerated list items. If the leftmost column is beyond the
2355preceding lines, the region is moved to the right by
2356`rst-shift-basic-offset'. With a prefix argument, do not
2357automatically fill the region."
2358 (interactive "P")
2359 (let ((rst-shift-fill-region
2360 (if (not pfxarg) rst-shift-fill-region)))
2361 (rst-shift-region-guts (lambda (tabs leftmostcol)
2362 (let ((cur tabs))
2363 (while (and cur (<= (caar cur) leftmostcol))
2364 (setq cur (cdr cur)))
2365 cur))
2366 'identity
2367 )))
2368
2369(defun rst-shift-region-left (pfxarg)
2370 "Like `rst-shift-region-right', except we move to the left.
2371Also, if invoked with a negative prefix arg, the entire
2372indentation is removed, up to the leftmost character in the
2373region, and automatic filling is disabled."
2374 (interactive "P")
2375 (let ((mbeg (copy-marker (region-beginning)))
2376 (mend (copy-marker (region-end)))
2377 (leftmostcol (rst-find-leftmost-column
2378 (region-beginning) (region-end)))
2379 (rst-shift-fill-region
2380 (if (not pfxarg) rst-shift-fill-region)))
2381
2382 (when (> leftmostcol 0)
2383 (if (and pfxarg (< (prefix-numeric-value pfxarg) 0))
2384 (progn
2385 (indent-rigidly (region-beginning) (region-end) (- leftmostcol))
2386 (when rst-shift-fill-region
2387 (fill-region mbeg mend))
2388 )
2389 (rst-shift-region-guts (lambda (tabs leftmostcol)
2390 (let ((cur (reverse tabs)))
2391 (while (and cur (>= (caar cur) leftmostcol))
2392 (setq cur (cdr cur)))
2393 cur))
2394 '-
2395 ))
2396 )))
2397
2398(defmacro rst-iterate-leftmost-paragraphs 2674(defmacro rst-iterate-leftmost-paragraphs
2399 (beg end first-only body-consequent body-alternative) 2675 (beg end first-only body-consequent body-alternative)
2400 "FIXME This definition is old and deprecated / we need to move 2676 "FIXME This definition is old and deprecated / we need to move
@@ -2419,9 +2695,9 @@ of each paragraph only."
2419 (current-column)) 2695 (current-column))
2420 2696
2421 (valid (and (= curcol leftcol) 2697 (valid (and (= curcol leftcol)
2422 (not (looking-at "[ \t]*$"))) 2698 (not (looking-at (rst-re 'lin-end))))
2423 (and (= curcol leftcol) 2699 (and (= curcol leftcol)
2424 (not (looking-at "[ \t]*$")))) 2700 (not (looking-at (rst-re 'lin-end)))))
2425 ) 2701 )
2426 ((>= (point) endm)) 2702 ((>= (point) endm))
2427 2703
@@ -2433,7 +2709,6 @@ of each paragraph only."
2433 2709
2434 )))) 2710 ))))
2435 2711
2436
2437(defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body) 2712(defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body)
2438 "Evaluate BODY for each line in region defined by BEG END. 2713 "Evaluate BODY for each line in region defined by BEG END.
2439LEFTMOST is set to true if the line is one of the leftmost of the 2714LEFTMOST is set to true if the line is one of the leftmost of the
@@ -2453,8 +2728,8 @@ first of a paragraph."
2453 2728
2454 (empty-line-previous nil ,isempty) 2729 (empty-line-previous nil ,isempty)
2455 2730
2456 (,isempty (looking-at "[ \t]*$") 2731 (,isempty (looking-at (rst-re 'lin-end))
2457 (looking-at "[ \t]*$")) 2732 (looking-at (rst-re 'lin-end)))
2458 2733
2459 (,parabegin (not ,isempty) 2734 (,parabegin (not ,isempty)
2460 (and empty-line-previous 2735 (and empty-line-previous
@@ -2471,6 +2746,307 @@ first of a paragraph."
2471 2746
2472 ))))) 2747 )))))
2473 2748
2749;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2750;; Indentation
2751
2752;; FIXME: At the moment only block comments with leading empty comment line are
2753;; supported; comment lines with leading comment markup should be also
2754;; supported; may be a customizable option could control which style to prefer
2755
2756(defgroup rst-indent nil "Settings for indendation in reStructuredText.
2757
2758In reStructuredText indendation points are usually determined by
2759preceding lines. Sometimes the syntax allows arbitrary
2760indendation points such as where to start the first line
2761following a directive. These indentation widths can be customized
2762here."
2763 :group 'rst
2764 :package-version '(rst . "1.1.0"))
2765
2766(define-obsolete-variable-alias
2767 'rst-shift-basic-offset 'rst-indent-width "r6713")
2768(defcustom rst-indent-width 2
2769 "Indentation when there is no more indentation point given."
2770 :group 'rst-indent
2771 :type '(integer))
2772
2773(defcustom rst-indent-field 3
2774 "Default indendation for first line after a field or 0 to always indent for
2775content."
2776 :group 'rst-indent
2777 :type '(integer))
2778
2779(defcustom rst-indent-literal-normal 3
2780 "Default indendation for literal block after a markup on an own
2781line."
2782 :group 'rst-indent
2783 :type '(integer))
2784
2785(defcustom rst-indent-literal-minimized 2
2786 "Default indendation for literal block after a minimized
2787markup."
2788 :group 'rst-indent
2789 :type '(integer))
2790
2791(defcustom rst-indent-comment 3
2792 "Default indendation for first line of a comment."
2793 :group 'rst-indent
2794 :type '(integer))
2795
2796;; FIXME: Must consider other tabs:
2797;; * Line blocks
2798;; * Definition lists
2799;; * Option lists
2800(defun rst-line-tabs ()
2801 "Return tabs of the current line or nil for no tab.
2802The list is sorted so the tab where writing continues most likely
2803is the first one. Each tab is of the form (COLUMN . INNER).
2804COLUMN is the column of the tab. INNER is non-nil if this is an
2805inner tab. I.e. a tab which does come from the basic indentation
2806and not from inner alignment points."
2807 (save-excursion
2808 (forward-line 0)
2809 (save-match-data
2810 (unless (looking-at (rst-re 'lin-end))
2811 (back-to-indentation)
2812 ;; Current indendation is always the least likely tab
2813 (let ((tabs (list (list (point) 0 nil)))) ; (POINT OFFSET INNER)
2814 ;; Push inner tabs more likely to continue writing
2815 (cond
2816 ;; Item
2817 ((looking-at (rst-re '(:grp itmany-tag hws-sta) '(:grp "\\S ") "?"))
2818 (when (match-string 2)
2819 (push (list (match-beginning 2) 0 t) tabs)))
2820 ;; Field
2821 ((looking-at (rst-re '(:grp fld-tag) '(:grp hws-tag)
2822 '(:grp "\\S ") "?"))
2823 (unless (zerop rst-indent-field)
2824 (push (list (match-beginning 1) rst-indent-field t) tabs))
2825 (if (match-string 3)
2826 (push (list (match-beginning 3) 0 t) tabs)
2827 (if (zerop rst-indent-field)
2828 (push (list (match-end 2)
2829 (if (string= (match-string 2) "") 1 0)
2830 t) tabs))))
2831 ;; Directive
2832 ((looking-at (rst-re 'dir-sta-3 '(:grp "\\S ") "?"))
2833 (push (list (match-end 1) 0 t) tabs)
2834 (unless (string= (match-string 2) "")
2835 (push (list (match-end 2) 0 t) tabs))
2836 (when (match-string 4)
2837 (push (list (match-beginning 4) 0 t) tabs)))
2838 ;; Footnote or citation definition
2839 ((looking-at (rst-re 'fnc-sta-2 '(:grp "\\S ") "?"))
2840 (push (list (match-end 1) 0 t) tabs)
2841 (when (match-string 3)
2842 (push (list (match-beginning 3) 0 t) tabs)))
2843 ;; Comment
2844 ((looking-at (rst-re 'cmt-sta-1))
2845 (push (list (point) rst-indent-comment t) tabs)))
2846 ;; Start of literal block
2847 (when (looking-at (rst-re 'lit-sta-2))
2848 (let ((tab0 (first tabs)))
2849 (push (list (first tab0)
2850 (+ (second tab0)
2851 (if (match-string 1)
2852 rst-indent-literal-minimized
2853 rst-indent-literal-normal))
2854 t) tabs)))
2855 (mapcar (lambda (tab)
2856 (goto-char (first tab))
2857 (cons (+ (current-column) (second tab)) (third tab)))
2858 tabs))))))
2859
2860(defun rst-compute-tabs (pt)
2861 "Build the list of possible tabs for all lines above.
2862Search backwards from point PT to build the list of possible
2863tabs. Return a list of tabs sorted by likeliness to continue
2864writing like `rst-line-tabs'. Nearer lines have generally a
2865higher likeliness than farer lines. Return nil if no tab is found
2866in the text above."
2867 (save-excursion
2868 (goto-char pt)
2869 (let (leftmost ; Leftmost column found so far
2870 innermost ; Leftmost column for inner tab
2871 tablist)
2872 (while (and (zerop (forward-line -1))
2873 (or (not leftmost)
2874 (> leftmost 0)))
2875 (let* ((tabs (rst-line-tabs))
2876 (leftcol (if tabs (apply 'min (mapcar 'car tabs)))))
2877 (when tabs
2878 ;; Consider only lines indented less or same if not INNERMOST
2879 (when (or (not leftmost)
2880 (< leftcol leftmost)
2881 (and (not innermost) (= leftcol leftmost)))
2882 (dolist (tab tabs)
2883 (let ((inner (cdr tab))
2884 (newcol (car tab)))
2885 (when (and
2886 (or
2887 (and (not inner)
2888 (or (not leftmost)
2889 (< newcol leftmost)))
2890 (and inner
2891 (or (not innermost)
2892 (< newcol innermost))))
2893 (not (memq newcol tablist)))
2894 (push newcol tablist))))
2895 (setq innermost (if (some 'identity
2896 (mapcar 'cdr tabs)) ; Has inner
2897 leftcol
2898 innermost))
2899 (setq leftmost leftcol)))))
2900 (nreverse tablist))))
2901
2902(defun rst-indent-line (&optional dflt)
2903 "Indent current line to next best reStructuredText tab.
2904The next best tab is taken from the tab list returned by
2905`rst-compute-tabs' which is used in a cyclic manner. If the
2906current indentation does not end on a tab use the first one. If
2907the current indentation is on a tab use the next tab. This allows
2908a repeated use of \\[indent-for-tab-command] to cycle through all
2909possible tabs. If no indentation is possible return `noindent' or
2910use DFLT. Return the indentation indented to. When point is in
2911indentation it ends up at its end. Otherwise the point is kept
2912relative to the content."
2913 (let* ((pt (point-marker))
2914 (cur (current-indentation))
2915 (clm (current-column))
2916 (tabs (rst-compute-tabs (point)))
2917 (fnd (position cur tabs))
2918 ind)
2919 (if (and (not tabs) (not dflt))
2920 'noindent
2921 (if (not tabs)
2922 (setq ind dflt)
2923 (if (not fnd)
2924 (setq fnd 0)
2925 (setq fnd (1+ fnd))
2926 (if (>= fnd (length tabs))
2927 (setq fnd 0)))
2928 (setq ind (nth fnd tabs)))
2929 (indent-line-to ind)
2930 (if (> clm cur)
2931 (goto-char pt))
2932 (set-marker pt nil)
2933 ind)))
2934
2935(defun rst-shift-region (beg end cnt)
2936 "Shift region BEG to END by CNT tabs.
2937Shift by one tab to the right (CNT > 0) or left (CNT < 0) or
2938remove all indentation (CNT = 0). An tab is taken from the text
2939above. If no suitable tab is found `rst-indent-width' is used."
2940 (interactive "r\np")
2941 (let ((tabs (sort (rst-compute-tabs beg) (lambda (x y) (<= x y))))
2942 (leftmostcol (rst-find-leftmost-column beg end)))
2943 (when (or (> leftmostcol 0) (> cnt 0))
2944 ;; Apply the indent
2945 (indent-rigidly
2946 beg end
2947 (if (zerop cnt)
2948 (- leftmostcol)
2949 ;; Find the next tab after the leftmost column
2950 (let* ((cmp (if (> cnt 0) '> '<))
2951 (tabs (if (> cnt 0) tabs (reverse tabs)))
2952 (len (length tabs))
2953 (dir (signum cnt)) ; Direction to take
2954 (abs (abs cnt)) ; Absolute number of steps to take
2955 ;; Get the position of the first tab beyond leftmostcol
2956 (fnd (position-if (lambda (elt)
2957 (funcall cmp elt leftmostcol))
2958 tabs))
2959 ;; Virtual position of tab
2960 (pos (+ (or fnd len) (1- abs)))
2961 (tab (if (< pos len)
2962 ;; Tab exists - use it
2963 (nth pos tabs)
2964 ;; Column needs to be computed
2965 (let ((col (+ (or (car (last tabs)) leftmostcol)
2966 ;; Base on last known column
2967 (* (- pos (1- len)) ; Distance left
2968 dir ; Direction to take
2969 rst-indent-width))))
2970 (if (< col 0) 0 col)))))
2971 (- tab leftmostcol)))))))
2972
2973;; FIXME: A paragraph with an (incorrectly) indented second line is not filled
2974;; correctly::
2975;;
2976;; Some start
2977;; continued wrong
2978(defun rst-adaptive-fill ()
2979 "Return fill prefix found at point.
2980Value for `adaptive-fill-function'."
2981 (let ((fnd (if (looking-at adaptive-fill-regexp)
2982 (match-string-no-properties 0))))
2983 (if (save-match-data
2984 (not (string-match comment-start-skip fnd)))
2985 ;; An non-comment prefix is fine
2986 fnd
2987 ;; Matches a comment - return whitespace instead
2988 (make-string (-
2989 (save-excursion
2990 (goto-char (match-end 0))
2991 (current-column))
2992 (save-excursion
2993 (goto-char (match-beginning 0))
2994 (current-column))) ? ))))
2995
2996;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2997;; Comments
2998
2999(defun rst-comment-line-break (&optional soft)
3000 "Break line and indent, continuing reStructuredText comment if within one.
3001Value for `comment-line-break-function'."
3002 (if soft
3003 (insert-and-inherit ?\n)
3004 (newline 1))
3005 (save-excursion
3006 (forward-char -1)
3007 (delete-horizontal-space))
3008 (delete-horizontal-space)
3009 (let ((tabs (rst-compute-tabs (point))))
3010 (when tabs
3011 (indent-line-to (car tabs)))))
3012
3013(defun rst-comment-indent ()
3014 "Return indentation for current comment line."
3015 (car (rst-compute-tabs (point))))
3016
3017(defun rst-comment-insert-comment ()
3018 "Insert a comment in the current line."
3019 (rst-indent-line 0)
3020 (insert comment-start))
3021
3022(defun rst-comment-region (beg end &optional arg)
3023 "Comment the current region or uncomment it if ARG is \\[universal-argument]."
3024 (save-excursion
3025 (if (consp arg)
3026 (rst-uncomment-region beg end arg)
3027 (goto-char beg)
3028 (let ((ind (current-indentation))
3029 bol)
3030 (forward-line 0)
3031 (setq bol (point))
3032 (indent-rigidly bol end rst-indent-comment)
3033 (goto-char bol)
3034 (open-line 1)
3035 (indent-line-to ind)
3036 (insert (comment-string-strip comment-start t t))))))
3037
3038(defun rst-uncomment-region (beg end &optional arg)
3039 "Uncomment the current region.
3040ARG is ignored"
3041 (save-excursion
3042 (let (bol eol)
3043 (goto-char beg)
3044 (forward-line 0)
3045 (setq bol (point))
3046 (forward-line 1)
3047 (setq eol (point))
3048 (indent-rigidly eol end (- rst-indent-comment))
3049 (delete-region bol eol))))
2474 3050
2475;;------------------------------------------------------------------------------ 3051;;------------------------------------------------------------------------------
2476 3052
@@ -2478,60 +3054,54 @@ first of a paragraph."
2478;; bullets in bulleted lists. The enumerate would just be one of the possible 3054;; bullets in bulleted lists. The enumerate would just be one of the possible
2479;; outputs. 3055;; outputs.
2480;; 3056;;
2481;; FIXME: TODO we need to do the enumeration removal as well. 3057;; FIXME: We need to do the enumeration removal as well.
2482 3058
2483(defun rst-enumerate-region (beg end) 3059(defun rst-enumerate-region (beg end all)
2484 "Add enumeration to all the leftmost paragraphs in the given region. 3060 "Add enumeration to all the leftmost paragraphs in the given region.
2485The region is specified between BEG and END. With prefix argument, 3061The region is specified between BEG and END. With ALL,
2486do all lines instead of just paragraphs." 3062do all lines instead of just paragraphs."
2487 (interactive "r") 3063 (interactive "r\nP")
2488 (let ((count 0) 3064 (let ((count 0)
2489 (last-insert-len nil)) 3065 (last-insert-len nil))
2490 (rst-iterate-leftmost-paragraphs 3066 (rst-iterate-leftmost-paragraphs
2491 beg end (not current-prefix-arg) 3067 beg end (not all)
2492 (let ((ins-string (format "%d. " (incf count)))) 3068 (let ((ins-string (format "%d. " (incf count))))
2493 (setq last-insert-len (length ins-string)) 3069 (setq last-insert-len (length ins-string))
2494 (insert ins-string)) 3070 (insert ins-string))
2495 (insert (make-string last-insert-len ?\ )) 3071 (insert (make-string last-insert-len ?\ ))
2496 ))) 3072 )))
2497 3073
2498(defun rst-bullet-list-region (beg end) 3074(defun rst-bullet-list-region (beg end all)
2499 "Add bullets to all the leftmost paragraphs in the given region. 3075 "Add bullets to all the leftmost paragraphs in the given region.
2500The region is specified between BEG and END. With prefix argument, 3076The region is specified between BEG and END. With ALL,
2501do all lines instead of just paragraphs." 3077do all lines instead of just paragraphs."
2502 (interactive "r") 3078 (interactive "r\nP")
2503 (rst-iterate-leftmost-paragraphs 3079 (rst-iterate-leftmost-paragraphs
2504 beg end (not current-prefix-arg) 3080 beg end (not all)
2505 (insert "- ") 3081 (insert (car rst-preferred-bullets) " ")
2506 (insert " ") 3082 (insert " ")
2507 )) 3083 ))
2508 3084
2509 3085;; FIXME: Does not deal with a varying number of digits appropriately
2510;; FIXME: there are some problems left with the following function 3086;; FIXME: Does not deal with multiple levels independently
2511;; implementation: 3087;; FIXME: Does not indent a multiline item correctly
2512;;
2513;; * It does not deal with a varying number of digits appropriately
2514;; * It does not deal with multiple levels independently, and it should.
2515;;
2516;; I suppose it does 90% of the job for now.
2517
2518(defun rst-convert-bullets-to-enumeration (beg end) 3088(defun rst-convert-bullets-to-enumeration (beg end)
2519 "Convert all the bulleted items and enumerated items in the 3089 "Convert the bulleted and enumerated items in the region to enumerated lists.
2520region to enumerated lists, renumbering as necessary." 3090Renumber as necessary."
2521 (interactive "r") 3091 (interactive "r")
2522 (let* (;; Find items and convert the positions to markers. 3092 (let* (;; Find items and convert the positions to markers.
2523 (items (mapcar 3093 (items (mapcar
2524 (lambda (x) 3094 (lambda (x)
2525 (cons (copy-marker (car x)) 3095 (cons (copy-marker (car x))
2526 (cdr x))) 3096 (cdr x)))
2527 (rst-find-pfx-in-region beg end rst-re-items))) 3097 (rst-find-pfx-in-region beg end (rst-re 'itmany-sta-1))))
2528 (count 1) 3098 (count 1)
2529 ) 3099 )
2530 (save-excursion 3100 (save-excursion
2531 (dolist (x items) 3101 (dolist (x items)
2532 (goto-char (car x)) 3102 (goto-char (car x))
2533 (looking-at rst-re-items) 3103 (looking-at (rst-re 'itmany-beg-1))
2534 (replace-match (format "%d. " count) nil nil nil 1) 3104 (replace-match (format "%d." count) nil nil nil 1)
2535 (incf count) 3105 (incf count)
2536 )) 3106 ))
2537 )) 3107 ))
@@ -2559,9 +3129,13 @@ With prefix argument set the empty lines too."
2559 3129
2560 3130
2561;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3131;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3132;; Font lock
3133;; =========
2562 3134
2563(require 'font-lock) 3135(require 'font-lock)
2564 3136
3137;; FIXME: The obsolete variables need to disappear
3138
2565(defgroup rst-faces nil "Faces used in Rst Mode." 3139(defgroup rst-faces nil "Faces used in Rst Mode."
2566 :group 'rst 3140 :group 'rst
2567 :group 'faces 3141 :group 'faces
@@ -2724,8 +3298,7 @@ general but you do not like the details."
2724 :type '(integer) 3298 :type '(integer)
2725 :set 'rst-set-level-default) 3299 :set 'rst-set-level-default)
2726(defcustom rst-level-face-base-color "grey" 3300(defcustom rst-level-face-base-color "grey"
2727 "The base name of the color to be used for creating background colors in 3301 "Base name of the color for creating background colors in section title faces."
2728section title faces for all levels."
2729 :group 'rst-faces-defaults 3302 :group 'rst-faces-defaults
2730 :type '(string) 3303 :type '(string)
2731 :set 'rst-set-level-default) 3304 :set 'rst-set-level-default)
@@ -2788,6 +3361,7 @@ details check the Rst Faces Defaults group."
2788 :value-type (face)) 3361 :value-type (face))
2789 :set-after '(rst-level-face-max)) 3362 :set-after '(rst-level-face-max))
2790 3363
3364;; FIXME: It should be possible to give "#RRGGBB" type of color values
2791(defun rst-define-level-faces () 3365(defun rst-define-level-faces ()
2792 "Define the faces for the section title text faces from the values." 3366 "Define the faces for the section title text faces from the values."
2793 ;; All variables used here must be checked in `rst-set-level-default' 3367 ;; All variables used here must be checked in `rst-set-level-default'
@@ -2804,214 +3378,277 @@ details check the Rst Faces Defaults group."
2804 (set-face-doc-string sym doc) 3378 (set-face-doc-string sym doc)
2805 (set-face-background sym col) 3379 (set-face-background sym col)
2806 (set sym sym)) 3380 (set sym sym))
2807 (setq i (1+ i)))))) 3381 (setq i (1+ i))))))
2808 3382
2809(rst-define-level-faces) 3383(rst-define-level-faces)
2810 3384
2811
2812;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3385;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2813;; Font lock
2814
2815(defvar rst-use-char-classes
2816 (string-match "[[:alpha:]]" "b")
2817 "Non-nil if we can use the character classes in our regexps.")
2818 3386
2819(defun rst-font-lock-keywords-function () 3387(defvar rst-font-lock-keywords
2820 "Return keywords to highlight in Rst mode according to current settings."
2821 ;; The reST-links in the comments below all relate to sections in 3388 ;; The reST-links in the comments below all relate to sections in
2822 ;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html 3389 ;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html
2823 (let* ( ;; This gets big - so let's define some abbreviations 3390 `(;; FIXME: Block markup is not recognized in blocks after explicit markup
2824 ;; horizontal white space 3391 ;; start
2825 (re-hws "[\t ]") 3392
2826 ;; beginning of line with possible indentation 3393 ;; Simple `Body Elements`_
2827 (re-bol (concat "^" re-hws "*")) 3394 ;; `Bullet Lists`_
2828 ;; Separates block lead-ins from their content 3395 ;; FIXME: A bullet directly after a field name is not recognized
2829 (re-blksep1 (concat "\\(" re-hws "+\\|$\\)")) 3396 (,(rst-re 'lin-beg '(:grp bul-sta))
2830 ;; explicit markup tag 3397 1 rst-block-face)
2831 (re-emt "\\.\\.") 3398 ;; `Enumerated Lists`_
2832 ;; explicit markup start 3399 (,(rst-re 'lin-beg '(:grp enmany-sta))
2833 (re-ems (concat re-emt re-hws "+")) 3400 1 rst-block-face)
2834 ;; inline markup prefix 3401 ;; `Definition Lists`_ FIXME: missing
2835 (re-imp1 (concat "\\(^\\|" re-hws "\\|[-'\"([{</:]\\)")) 3402 ;; `Field Lists`_
2836 ;; inline markup suffix 3403 (,(rst-re 'lin-beg '(:grp fld-tag) 'bli-sfx)
2837 (re-ims1 (concat "\\(" re-hws "\\|[]-'\")}>/:.,;!?\\]\\|$\\)")) 3404 1 rst-external-face)
2838 ;; symbol character 3405 ;; `Option Lists`_
2839 (re-sym1 "\\(\\sw\\|\\s_\\)") 3406 (,(rst-re 'lin-beg '(:grp opt-tag (:shy optsep-tag opt-tag) "*")
2840 ;; inline markup content begin 3407 '(:alt "$" (:seq hws-prt "\\{2\\}")))
2841 (re-imbeg2 "\\(\\S \\|\\S \\([^") 3408 1 rst-block-face)
2842 3409 ;; `Line Blocks`_
2843 ;; There seems to be a bug leading to error "Stack overflow in regexp 3410 ;; Only for lines containing no more bar - to distinguish from tables
2844 ;; matcher" when "|" or "\\*" are the characters searched for 3411 (,(rst-re 'lin-beg '(:grp "|" bli-sfx) "[^|\n]*$")
2845 (re-imendbeg "\\]\\|\\\\.") 3412 1 rst-block-face)
2846 ;; inline markup content end 3413
2847 (re-imend (concat re-imendbeg "\\)*[^\t \\\\]\\)")) 3414 ;; `Tables`_ FIXME: missing
2848 ;; inline markup content without asterisk 3415
2849 (re-ima2 (concat re-imbeg2 "*" re-imend)) 3416 ;; All the `Explicit Markup Blocks`_
2850 ;; inline markup content without backquote 3417 ;; `Footnotes`_ / `Citations`_
2851 (re-imb2 (concat re-imbeg2 "`" re-imend)) 3418 (,(rst-re 'lin-beg 'fnc-sta-2)
2852 ;; inline markup content without vertical bar 3419 (1 rst-definition-face)
2853 (re-imv2 (concat re-imbeg2 "|" re-imend)) 3420 (2 rst-definition-face))
2854 ;; Supported URI schemes 3421 ;; `Directives`_ / `Substitution Definitions`_
2855 (re-uris1 "\\(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\\)") 3422 (,(rst-re 'lin-beg 'dir-sta-3)
2856 ;; Line starting with adornment and optional whitespace; complete 3423 (1 rst-directive-face)
2857 ;; adornment is in (match-string 1); there must be at least 3 3424 (2 rst-definition-face)
2858 ;; characters because otherwise explicit markup start would be 3425 (3 rst-directive-face))
2859 ;; recognized 3426 ;; `Hyperlink Targets`_
2860 (re-ado2 (concat "^\\(\\([" 3427 (,(rst-re 'lin-beg
2861 (if rst-use-char-classes 3428 '(:grp exm-sta "_" (:alt
2862 "^[:word:][:space:][:cntrl:]" "^\\w \t\x00-\x1F") 3429 (:seq "`" ilcbkqdef-tag "`")
2863 "]\\)\\2\\2+\\)" re-hws "*$")) 3430 (:seq (:alt "[^:\\\n]" "\\\\.") "+")) ":")
2864 ) 3431 'bli-sfx)
2865 (list 3432 1 rst-definition-face)
2866 ;; FIXME: Block markup is not recognized in blocks after explicit markup 3433 (,(rst-re 'lin-beg '(:grp "__") 'bli-sfx)
2867 ;; start 3434 1 rst-definition-face)
2868 3435
2869 ;; Simple `Body Elements`_ 3436 ;; All `Inline Markup`_ - most of them may be multiline though this is
2870 ;; `Bullet Lists`_ 3437 ;; uninteresting
2871 `(,(concat re-bol "\\([-*+]" re-blksep1 "\\)") 3438
2872 1 rst-block-face) 3439 ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented
2873 ;; `Enumerated Lists`_ 3440 ;; `Strong Emphasis`_
2874 `(,(concat re-bol "\\((?\\(#\\|[0-9]+\\|[A-Za-z]\\|[IVXLCMivxlcm]+\\)[.)]" 3441 (,(rst-re 'ilm-pfx '(:grp "\\*\\*" ilcast-tag "\\*\\*") 'ilm-sfx)
2875 re-blksep1 "\\)") 3442 1 rst-emphasis2-face)
2876 1 rst-block-face) 3443 ;; `Emphasis`_
2877 ;; `Definition Lists`_ FIXME: missing 3444 (,(rst-re 'ilm-pfx '(:grp "\\*" ilcast-tag "\\*") 'ilm-sfx)
2878 ;; `Field Lists`_ 3445 1 rst-emphasis1-face)
2879 `(,(concat re-bol "\\(:[^:\n]+:\\)" re-blksep1) 3446 ;; `Inline Literals`_
2880 1 rst-external-face) 3447 (,(rst-re 'ilm-pfx '(:grp "``" ilcbkq-tag "``") 'ilm-sfx)
2881 ;; `Option Lists`_ 3448 1 rst-literal-face)
2882 `(,(concat re-bol "\\(\\(\\(\\([-+/]\\|--\\)\\sw\\(-\\|\\sw\\)*" 3449 ;; `Inline Internal Targets`_
2883 "\\([ =]\\S +\\)?\\)\\(,[\t ]\\)?\\)+\\)\\($\\|[\t ]\\{2\\}\\)") 3450 (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx)
2884 1 rst-block-face) 3451 1 rst-definition-face)
2885 3452 ;; `Hyperlink References`_
2886 ;; `Tables`_ FIXME: missing 3453 ;; FIXME: `Embedded URIs`_ not considered
2887 3454 ;; FIXME: Directly adjacing marked up words are not fontified correctly
2888 ;; All the `Explicit Markup Blocks`_ 3455 ;; unless they are not separated by two spaces: foo_ bar_
2889 ;; `Footnotes`_ / `Citations`_ 3456 (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`")
2890 `(,(concat re-bol "\\(" re-ems "\\[[^[\n]+\\]\\)" re-blksep1) 3457 (:seq "\\sw" (:alt "\\sw" "-") "+\\sw"))
2891 1 rst-definition-face) 3458 "__?") 'ilm-sfx)
2892 ;; `Directives`_ / `Substitution Definitions`_ 3459 1 rst-reference-face)
2893 `(,(concat re-bol "\\(" re-ems "\\)\\(\\(|[^|\n]+|[\t ]+\\)?\\)\\(" 3460 ;; `Interpreted Text`_
2894 re-sym1 "+::\\)" re-blksep1) 3461 (,(rst-re 'ilm-pfx '(:grp (:shy ":" sym-tag ":") "?")
2895 (1 rst-directive-face) 3462 '(:grp "`" ilcbkq-tag "`")
2896 (2 rst-definition-face) 3463 '(:grp (:shy ":" sym-tag ":") "?") 'ilm-sfx)
2897 (4 rst-directive-face)) 3464 (1 rst-directive-face)
2898 ;; `Hyperlink Targets`_ 3465 (2 rst-external-face)
2899 `(,(concat re-bol "\\(" re-ems "_\\([^:\\`\n]\\|\\\\.\\|`[^`\n]+`\\)+:\\)" 3466 (3 rst-directive-face))
2900 re-blksep1) 3467 ;; `Footnote References`_ / `Citation References`_
2901 1 rst-definition-face) 3468 (,(rst-re 'ilm-pfx '(:grp fnc-tag "_") 'ilm-sfx)
2902 `(,(concat re-bol "\\(__\\)" re-blksep1) 3469 1 rst-reference-face)
2903 1 rst-definition-face) 3470 ;; `Substitution References`_
2904 3471 ;; FIXME: References substitutions like |this|_ or |this|__ are not
2905 ;; All `Inline Markup`_ 3472 ;; fontified correctly
2906 ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented 3473 (,(rst-re 'ilm-pfx '(:grp sub-tag) 'ilm-sfx)
2907 ;; `Strong Emphasis`_ 3474 1 rst-reference-face)
2908 `(,(concat re-imp1 "\\(\\*\\*" re-ima2 "\\*\\*\\)" re-ims1) 3475 ;; `Standalone Hyperlinks`_
2909 2 rst-emphasis2-face) 3476 ;; FIXME: This takes it easy by using a whitespace as delimiter
2910 ;; `Emphasis`_ 3477 (,(rst-re 'ilm-pfx '(:grp uri-tag ":\\S +") 'ilm-sfx)
2911 `(,(concat re-imp1 "\\(\\*" re-ima2 "\\*\\)" re-ims1) 3478 1 rst-definition-face)
2912 2 rst-emphasis1-face) 3479 (,(rst-re 'ilm-pfx '(:grp sym-tag "@" sym-tag ) 'ilm-sfx)
2913 ;; `Inline Literals`_ 3480 1 rst-definition-face)
2914 `(,(concat re-imp1 "\\(``" re-imb2 "``\\)" re-ims1) 3481
2915 2 rst-literal-face) 3482 ;; Do all block fontification as late as possible so 'append works
2916 ;; `Inline Internal Targets`_ 3483
2917 `(,(concat re-imp1 "\\(_`" re-imb2 "`\\)" re-ims1) 3484 ;; Sections_ / Transitions_ - for sections this is multiline
2918 2 rst-definition-face) 3485 (,(rst-re 'ado-beg-2-1)
2919 ;; `Hyperlink References`_ 3486 (rst-font-lock-handle-adornment-matcher
2920 ;; FIXME: `Embedded URIs`_ not considered 3487 (rst-font-lock-handle-adornment-pre-match-form
2921 `(,(concat re-imp1 "\\(\\(`" re-imb2 "`\\|\\(\\sw\\(\\sw\\|-\\)+\\sw\\)\\)__?\\)" re-ims1) 3488 (match-string-no-properties 1) (match-end 1))
2922 2 rst-reference-face) 3489 nil
2923 ;; `Interpreted Text`_ 3490 (1 (cdr (assoc nil rst-adornment-faces-alist)) append t)
2924 `(,(concat re-imp1 "\\(\\(:" re-sym1 "+:\\)?\\)\\(`" re-imb2 "`\\)\\(\\(:" 3491 (2 (cdr (assoc rst-font-lock-adornment-level
2925 re-sym1 "+:\\)?\\)" re-ims1) 3492 rst-adornment-faces-alist)) append t)
2926 (2 rst-directive-face) 3493 (3 (cdr (assoc nil rst-adornment-faces-alist)) append t)))
2927 (5 rst-external-face) 3494
2928 (8 rst-directive-face)) 3495 ;; FIXME: FACESPEC could be used instead of ordinary faces to set
2929 ;; `Footnote References`_ / `Citation References`_ 3496 ;; properties on comments and literal blocks so they are *not*
2930 `(,(concat re-imp1 "\\(\\[[^]]+\\]_\\)" re-ims1) 3497 ;; inline fontified; see (elisp)Search-based Fontification
2931 2 rst-reference-face) 3498
2932 ;; `Substitution References`_ 3499 ;; FIXME: And / or use `syntax-propertize` functions as in `octave-mod.el`
2933 `(,(concat re-imp1 "\\(|" re-imv2 "|\\)" re-ims1) 3500 ;; and other V24 modes; may make `font-lock-extend-region`
2934 2 rst-reference-face) 3501 ;; superfluous
2935 ;; `Standalone Hyperlinks`_ 3502
2936 `(;; FIXME: This takes it easy by using a whitespace as delimiter 3503 ;; `Comments`_ - this is multiline
2937 ,(concat re-imp1 "\\(" re-uris1 ":\\S +\\)" re-ims1) 3504 (,(rst-re 'lin-beg 'cmt-sta-1)
2938 2 rst-definition-face) 3505 (1 rst-comment-face)
2939 `(,(concat re-imp1 "\\(" re-sym1 "+@" re-sym1 "+\\)" re-ims1) 3506 (rst-font-lock-find-unindented-line-match
2940 2 rst-definition-face) 3507 (rst-font-lock-find-unindented-line-limit (match-end 1))
2941 3508 nil
2942 ;; Do all block fontification as late as possible so 'append works 3509 (0 rst-comment-face append)))
2943 3510 (,(rst-re 'lin-beg '(:grp exm-tag) '(:grp hws-tag) "$")
2944 ;; Sections_ / Transitions_ 3511 (1 rst-comment-face)
2945 (append 3512 (2 rst-comment-face)
2946 (list 3513 (rst-font-lock-find-unindented-line-match
2947 re-ado2) 3514 (rst-font-lock-find-unindented-line-limit 'next)
2948 (if (not rst-mode-lazy) 3515 nil
2949 '(1 rst-block-face) 3516 (0 rst-comment-face append)))
2950 (list 3517
2951 (list 'rst-font-lock-handle-adornment 3518 ;; FIXME: This is not rendered as comment::
2952 '(progn 3519 ;; .. .. list-table::
2953 (setq rst-font-lock-adornment-point (match-end 1)) 3520 ;; :stub-columns: 1
2954 (point-max)) 3521 ;; :header-rows: 1
2955 nil 3522
2956 (list 1 '(cdr (assoc nil rst-adornment-faces-alist)) 3523 ;; FIXME: This is rendered wrong::
2957 'append t) 3524 ;;
2958 (list 2 '(cdr (assoc rst-font-lock-level 3525 ;; xxx yyy::
2959 rst-adornment-faces-alist)) 3526 ;;
2960 'append t) 3527 ;; ----|> KKKKK <|----
2961 (list 3 '(cdr (assoc nil rst-adornment-faces-alist)) 3528 ;; / \
2962 'append t))))) 3529 ;; -|> AAAAAAAAAAPPPPPP <|- -|> AAAAAAAAAABBBBBBB <|-
2963 3530 ;; | | | |
2964 ;; `Comments`_ 3531 ;; | | | |
2965 (append 3532 ;; PPPPPP PPPPPPDDDDDDD BBBBBBB PPPPPPBBBBBBB
2966 (list 3533 ;;
2967 (concat re-bol "\\(" re-ems "\\)\[^[|_]\\([^:\n]\\|:\\([^:\n]\\|$\\)\\)*$") 3534 ;; Indentation needs to be taken from the line with the ``::`` and not from
2968 3535 ;; the first content line.
2969 '(1 rst-comment-face))
2970 (if rst-mode-lazy
2971 (list
2972 (list 'rst-font-lock-find-unindented-line
2973 '(progn
2974 (setq rst-font-lock-indentation-point (match-end 1))
2975 (point-max))
2976 nil
2977 '(0 rst-comment-face append)))))
2978 (append
2979 (list
2980 (concat re-bol "\\(" re-emt "\\)\\(\\s *\\)$")
2981 '(1 rst-comment-face)
2982 '(2 rst-comment-face))
2983 (if rst-mode-lazy
2984 (list
2985 (list 'rst-font-lock-find-unindented-line
2986 '(progn
2987 (setq rst-font-lock-indentation-point 'next)
2988 (point-max))
2989 nil
2990 '(0 rst-comment-face append)))))
2991
2992 ;; `Literal Blocks`_
2993 (append
2994 (list
2995 (concat re-bol "\\(\\([^.\n]\\|\\.[^.\n]\\).*\\)?\\(::\\)$")
2996 '(3 rst-block-face))
2997 (if rst-mode-lazy
2998 (list
2999 (list 'rst-font-lock-find-unindented-line
3000 '(progn
3001 (setq rst-font-lock-indentation-point t)
3002 (point-max))
3003 nil
3004 '(0 rst-literal-face append)))))
3005 3536
3006 ;; `Doctest Blocks`_ 3537 ;; `Indented Literal Blocks`_ - this is multiline
3007 (append 3538 (,(rst-re 'lin-beg 'lit-sta-2)
3008 (list 3539 (2 rst-block-face)
3009 (concat re-bol "\\(>>>\\|\\.\\.\\.\\)\\(.+\\)") 3540 (rst-font-lock-find-unindented-line-match
3010 '(1 rst-block-face) 3541 (rst-font-lock-find-unindented-line-limit t)
3011 '(2 rst-literal-face))) 3542 nil
3012 ))) 3543 (0 rst-literal-face append)))
3013 3544
3545 ;; FIXME: `Quoted Literal Blocks`_ missing - this is multiline
3014 3546
3547 ;; `Doctest Blocks`_
3548 ;; FIXME: This is wrong according to the specification:
3549 ;;
3550 ;; Doctest blocks are text blocks which begin with ">>> ", the Python
3551 ;; interactive interpreter main prompt, and end with a blank line.
3552 ;; Doctest blocks are treated as a special case of literal blocks,
3553 ;; without requiring the literal block syntax. If both are present, the
3554 ;; literal block syntax takes priority over Doctest block syntax:
3555 ;;
3556 ;; This is an ordinary paragraph.
3557 ;;
3558 ;; >>> print 'this is a Doctest block'
3559 ;; this is a Doctest block
3560 ;;
3561 ;; The following is a literal block::
3562 ;;
3563 ;; >>> This is not recognized as a doctest block by
3564 ;; reStructuredText. It *will* be recognized by the doctest
3565 ;; module, though!
3566 ;;
3567 ;; Indentation is not required for doctest blocks.
3568 (,(rst-re 'lin-beg '(:grp (:alt ">>>" ell-tag)) '(:grp ".+"))
3569 (1 rst-block-face)
3570 (2 rst-literal-face))
3571 )
3572 "Keywords to highlight in rst mode.")
3573
3574(defun rst-font-lock-extend-region ()
3575 "Extend the region `font-lock-beg' / `font-lock-end' iff it may
3576be in the middle of a multiline construct and return non-nil if so."
3577 (let ((r (rst-font-lock-extend-region-internal font-lock-beg font-lock-end)))
3578 (when r
3579 (setq font-lock-beg (car r))
3580 (setq font-lock-end (cdr r))
3581 t)))
3582
3583(defun rst-font-lock-extend-region-internal (beg end)
3584 "Check the region BEG / END for being in the middle of a multiline construct.
3585Return nil if not or a cons with new values for BEG / END"
3586 (let ((nbeg (rst-font-lock-extend-region-extend beg -1))
3587 (nend (rst-font-lock-extend-region-extend end 1)))
3588 (if (or nbeg nend)
3589 (cons (or nbeg beg) (or nend end)))))
3590
3591(defun rst-forward-line (&optional n)
3592 "Like `forward-line' but always end up in column 0 and return accordingly."
3593 (let ((moved (forward-line n)))
3594 (if (bolp)
3595 moved
3596 (forward-line 0)
3597 (- moved (signum n)))))
3598
3599(defun rst-font-lock-extend-region-extend (pt dir)
3600 "Extend the region starting at point PT and extending in direction DIR.
3601Return extended point or nil if not moved."
3602 ;; There are many potential multiline constructs but there are two groups
3603 ;; which are really relevant. The first group consists of
3604 ;;
3605 ;; * comment lines without leading explicit markup tag and
3606 ;;
3607 ;; * literal blocks following "::"
3608 ;;
3609 ;; which are both indented. Thus indendation is the first thing recognized
3610 ;; here. The second criteria is an explicit markup tag which may be a comment
3611 ;; or a double colon at the end of a line.
3612 ;;
3613 ;; The second group consists of the adornment cases.
3614 (if (not (get-text-property pt 'font-lock-multiline))
3615 ;; Move only if we don't start inside a multiline construct already
3616 (save-excursion
3617 (let (;; non-empty non-indented line, explicit markup tag or literal
3618 ;; block tag
3619 (stop-re (rst-re '(:alt "[^ \t\n]"
3620 (:seq hws-tag exm-tag)
3621 (:seq ".*" dcl-tag lin-end)))))
3622 ;; The comments below are for dir == -1 / dir == 1
3623 (goto-char pt)
3624 (forward-line 0)
3625 (setq pt (point))
3626 (while (and (not (looking-at stop-re))
3627 (zerop (rst-forward-line dir)))) ; try previous / next
3628 ; line if it exists
3629 (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline /
3630 ; overline
3631 (if (zerop (rst-forward-line dir))
3632 (if (looking-at (rst-re 'ttl-beg)) ; title found, i.e.
3633 ; underline / overline
3634 ; found
3635 (if (zerop (rst-forward-line dir))
3636 (if (not
3637 (looking-at (rst-re 'ado-beg-2-1))) ; no
3638 ; overline /
3639 ; underline
3640 (rst-forward-line (- dir)))) ; step back to title
3641 ; / adornment
3642 (if (< dir 0) ; keep downward adornment
3643 (rst-forward-line (- dir))))) ; step back to adornment
3644 (if (looking-at (rst-re 'ttl-beg)) ; may be a title
3645 (if (zerop (rst-forward-line dir))
3646 (if (not
3647 (looking-at (rst-re 'ado-beg-2-1))) ; no overline /
3648 ; underline
3649 (rst-forward-line (- dir)))))) ; step back to line
3650 (if (not (= (point) pt))
3651 (point))))))
3015 3652
3016;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3653;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3017;; Indented blocks 3654;; Indented blocks
@@ -3034,198 +3671,154 @@ point is not moved."
3034 (forward-line 1) 3671 (forward-line 1)
3035 (when (< (point) limit) 3672 (when (< (point) limit)
3036 (setq beg (point)) 3673 (setq beg (point))
3037 (if (looking-at "\\s *$") 3674 (if (looking-at (rst-re 'lin-end))
3038 (setq cand (or cand beg)) ; An empty line is a candidate 3675 (setq cand (or cand beg)) ; An empty line is a candidate
3039 (move-to-column clm) 3676 (move-to-column clm)
3040 ;; FIXME: No indentation [(zerop clm)] must be handled in some 3677 ;; FIXME: No indentation [(zerop clm)] must be handled in some
3041 ;; useful way - though it is not clear what this should mean at all 3678 ;; useful way - though it is not clear what this should mean at all
3042 (if (string-match 3679 (if (string-match
3043 "^\\s *$" (buffer-substring-no-properties beg (point))) 3680 (rst-re 'linemp-tag)
3681 (buffer-substring-no-properties beg (point)))
3044 (setq cand nil) ; An indented line resets a candidate 3682 (setq cand nil) ; An indented line resets a candidate
3045 (setq fnd (or cand beg))))))) 3683 (setq fnd (or cand beg)))))))
3046 (goto-char (or fnd start)) 3684 (goto-char (or fnd start))
3047 fnd)) 3685 fnd))
3048 3686
3049;; Stores the point where the current indentation ends if a number. If `next' 3687(defvar rst-font-lock-find-unindented-line-begin nil
3050;; indicates `rst-font-lock-find-unindented-line' shall take the indentation 3688 "Beginning of the match if `rst-font-lock-find-unindented-line-end'")
3051;; from the next line if this is not empty. If non-nil indicates 3689
3052;; `rst-font-lock-find-unindented-line' shall take the indentation from the 3690(defvar rst-font-lock-find-unindented-line-end nil
3053;; next non-empty line. Also used as a trigger for 3691 "End of the match as determined by `rst-font-lock-find-unindented-line-limit'.
3054;; `rst-font-lock-find-unindented-line'. 3692Also used as a trigger for
3055(defvar rst-font-lock-indentation-point nil) 3693`rst-font-lock-find-unindented-line-match'.")
3056 3694
3057(defun rst-font-lock-find-unindented-line (limit) 3695(defun rst-font-lock-find-unindented-line-limit (ind-pnt)
3058 (let* ((ind-pnt rst-font-lock-indentation-point) 3696 "Find the next unindented line relative to indenation at IND-PNT.
3059 (beg-pnt ind-pnt)) 3697Return this point, the end of the buffer or nil if nothing found.
3060 ;; May run only once - enforce this 3698If IND-PNT is `next' take the indentation from the next line if
3061 (setq rst-font-lock-indentation-point nil) 3699this is not empty and indented more than the current one. If
3062 (when (and ind-pnt (not (numberp ind-pnt))) 3700IND-PNT is non-nil but not a number take the indentation from the
3063 ;; Find indentation point in next line if any 3701next non-empty line if this is indented more than the current
3064 (setq ind-pnt 3702one."
3065 (save-excursion 3703 (setq rst-font-lock-find-unindented-line-begin ind-pnt)
3066 (save-match-data 3704 (setq rst-font-lock-find-unindented-line-end
3067 (if (eq ind-pnt 'next) 3705 (save-excursion
3068 (when (and (zerop (forward-line 1)) (< (point) limit)) 3706 (when (not (numberp ind-pnt))
3069 (setq beg-pnt (point)) 3707 ;; Find indentation point in next line if any
3070 (when (not (looking-at "\\s *$")) 3708 (setq ind-pnt
3071 (looking-at "\\s *") 3709 ;; FIXME: Should be refactored to two different functions
3072 (match-end 0))) 3710 ;; giving their result to this function, may be
3073 (while (and (zerop (forward-line 1)) (< (point) limit) 3711 ;; integrated in caller
3074 (looking-at "\\s *$"))) 3712 (save-match-data
3075 (when (< (point) limit) 3713 (let ((cur-ind (current-indentation)))
3076 (setq beg-pnt (point)) 3714 (if (eq ind-pnt 'next)
3077 (looking-at "\\s *") 3715 (when (and (zerop (forward-line 1))
3078 (match-end 0))))))) 3716 (< (point) (point-max)))
3079 (when ind-pnt 3717 ;; Not at EOF
3080 (goto-char ind-pnt) 3718 (setq rst-font-lock-find-unindented-line-begin
3081 ;; Always succeeds because the limit set by PRE-MATCH-FORM is the 3719 (point))
3082 ;; ultimate point to find 3720 (when (and (not (looking-at (rst-re 'lin-end)))
3083 (goto-char (or (rst-forward-indented-block nil limit) limit)) 3721 (> (current-indentation) cur-ind))
3084 (save-excursion 3722 ;; Use end of indentation if non-empty line
3085 ;; Include subsequent empty lines in the font-lock block, 3723 (looking-at (rst-re 'hws-tag))
3086 ;; in case the user subsequently changes the indentation of the next 3724 (match-end 0)))
3087 ;; non-empty line to move it into the indented element. 3725 ;; Skip until non-empty line or EOF
3088 (skip-chars-forward " \t\n") 3726 (while (and (zerop (forward-line 1))
3089 (put-text-property beg-pnt (point) 'font-lock-multiline t)) 3727 (< (point) (point-max))
3090 (set-match-data (list beg-pnt (point))) 3728 (looking-at (rst-re 'lin-end))))
3091 t))) 3729 (when (< (point) (point-max))
3730 ;; Not at EOF
3731 (setq rst-font-lock-find-unindented-line-begin
3732 (point))
3733 (when (> (current-indentation) cur-ind)
3734 ;; Indentation bigger than line of departure
3735 (looking-at (rst-re 'hws-tag))
3736 (match-end 0))))))))
3737 (when ind-pnt
3738 (goto-char ind-pnt)
3739 (or (rst-forward-indented-block nil (point-max))
3740 (point-max))))))
3741
3742(defun rst-font-lock-find-unindented-line-match (limit)
3743 "Set the match found by
3744`rst-font-lock-find-unindented-line-limit' the first time called
3745or nil."
3746 (when rst-font-lock-find-unindented-line-end
3747 (set-match-data
3748 (list rst-font-lock-find-unindented-line-begin
3749 rst-font-lock-find-unindented-line-end))
3750 (put-text-property rst-font-lock-find-unindented-line-begin
3751 rst-font-lock-find-unindented-line-end
3752 'font-lock-multiline t)
3753 ;; Make sure this is called only once
3754 (setq rst-font-lock-find-unindented-line-end nil)
3755 t))
3092 3756
3093;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3757;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3094;; Adornments 3758;; Adornments
3095 3759
3096(defvar rst-font-lock-adornment-point nil 3760(defvar rst-font-lock-adornment-level nil
3097 "Stores the point where the current adornment ends. 3761 "Storage for `rst-font-lock-handle-adornment-matcher'.
3098Also used as a trigger for `rst-font-lock-handle-adornment'.") 3762Either section level of the current adornment or t for a transition.")
3099 3763
3100;; Here `rst-font-lock-handle-adornment' stores the section level of the 3764(defun rst-adornment-level (key)
3101;; current adornment or t for a transition. 3765 "Return section level for adornment KEY.
3102(defvar rst-font-lock-level nil) 3766KEY is the first element of the return list of
3103 3767`rst-classify-adornment'. If KEY is not a cons return it. If KEY is found
3104;; FIXME: It would be good if this could be used to markup section titles of 3768in the hierarchy return its level. Otherwise return a level one
3105;; given level with a special key; it would be even better to be able to 3769beyond the existing hierarchy."
3106;; customize this so it can be used for a generally available personal style 3770 (if (not (consp key))
3107;; 3771 key
3108;; FIXME: There should be some way to reset and reload this variable - probably 3772 (let* ((hier (rst-get-hierarchy))
3109;; a special key 3773 (char (car key))
3110;; 3774 (style (cdr key)))
3111;; FIXME: Some support for `outline-mode' would be nice which should be based 3775 (1+ (or (position-if (lambda (elt)
3112;; on this information 3776 (and (equal (car elt) char)
3113(defvar rst-adornment-level-alist nil 3777 (equal (cadr elt) style))) hier)
3114 "Associates adornments with section levels. 3778 (length hier))))))
3115The key is a two character string. The first character is the adornment 3779
3116character. The second character distinguishes underline section titles (`u') 3780(defvar rst-font-lock-adornment-match nil
3117from overline/underline section titles (`o'). The value is the section level. 3781 "Storage for match for current adornment.
3118 3782Set by `rst-font-lock-handle-adornment-pre-match-form'. Also used
3119This is made buffer local on start and adornments found during font lock are 3783as a trigger for `rst-font-lock-handle-adornment-matcher'.")
3120entered.") 3784
3121 3785(defun rst-font-lock-handle-adornment-pre-match-form (ado ado-end)
3122;; Returns section level for adornment key KEY. Adds new section level if KEY 3786 "Determine limit for adornments for font-locking section titles and transitions.
3123;; is not found and ADD. If KEY is not a string it is simply returned. 3787In fact determine all things necessary and put the result to
3124(defun rst-adornment-level (key &optional add) 3788`rst-font-lock-adornment-match' and
3125 (let ((fnd (assoc key rst-adornment-level-alist)) 3789`rst-font-lock-adornment-level'. ADO is the complete adornment
3126 (new 1)) 3790matched. ADO-END is the point where ADO ends. Return the point
3127 (cond 3791where the whole adorned construct ends.
3128 ((not (stringp key)) 3792
3129 key) 3793Called as a PRE-MATCH-FORM in the sense of `font-lock-keywords'."
3130 (fnd 3794 (let ((ado-data (rst-classify-adornment ado ado-end)))
3131 (cdr fnd)) 3795 (if (not ado-data)
3132 (add 3796 (setq rst-font-lock-adornment-level nil
3133 (while (rassoc new rst-adornment-level-alist) 3797 rst-font-lock-adornment-match nil)
3134 (setq new (1+ new))) 3798 (setq rst-font-lock-adornment-level
3135 (setq rst-adornment-level-alist 3799 (rst-adornment-level (car ado-data)))
3136 (append rst-adornment-level-alist (list (cons key new)))) 3800 (setq rst-font-lock-adornment-match (cdr ado-data))
3137 new)))) 3801 (goto-char (nth 1 ado-data)) ; Beginning of construct
3138 3802 (nth 2 ado-data)))) ; End of construct
3139;; Classifies adornment for section titles and transitions. ADORNMENT is the 3803
3140;; complete adornment string as found in the buffer. END is the point after the 3804(defun rst-font-lock-handle-adornment-matcher (limit)
3141;; last character of ADORNMENT. For overline section adornment LIMIT limits the 3805 "Set the match found by `rst-font-lock-handle-adornment-pre-match-form'
3142;; search for the matching underline. Returns a list. The first entry is t for 3806the first time called or nil.
3143;; a transition, or a key string for `rst-adornment-level' for a section title. 3807
3144;; The following eight values forming four match groups as can be used for 3808Called as a MATCHER in the sense of `font-lock-keywords'."
3145;; `set-match-data'. First match group contains the maximum points of the whole 3809 (let ((match rst-font-lock-adornment-match))
3146;; construct. Second and last match group matched pure section title adornment
3147;; while third match group matched the section title text or the transition.
3148;; Each group but the first may or may not exist.
3149(defun rst-classify-adornment (adornment end limit)
3150 (save-excursion
3151 (save-match-data
3152 (goto-char end)
3153 (let ((ado-ch (aref adornment 0))
3154 (ado-re (regexp-quote adornment))
3155 (end-pnt (point))
3156 (beg-pnt (progn
3157 (forward-line 0)
3158 (point)))
3159 (nxt-emp
3160 (save-excursion
3161 (or (not (zerop (forward-line 1)))
3162 (looking-at "\\s *$"))))
3163 (prv-emp
3164 (save-excursion
3165 (or (not (zerop (forward-line -1)))
3166 (looking-at "\\s *$"))))
3167 key beg-ovr end-ovr beg-txt end-txt beg-und end-und)
3168 (cond
3169 ((and nxt-emp prv-emp)
3170 ;; A transition
3171 (setq key t)
3172 (setq beg-txt beg-pnt)
3173 (setq end-txt end-pnt))
3174 (prv-emp
3175 ;; An overline
3176 (setq key (concat (list ado-ch) "o"))
3177 (setq beg-ovr beg-pnt)
3178 (setq end-ovr end-pnt)
3179 (forward-line 1)
3180 (setq beg-txt (point))
3181 (while (and (< (point) limit) (not end-txt))
3182 (if (looking-at "\\s *$")
3183 ;; No underline found
3184 (setq end-txt (1- (point)))
3185 (when (looking-at (concat "\\(" ado-re "\\)\\s *$"))
3186 (setq end-und (match-end 1))
3187 (setq beg-und (point))
3188 (setq end-txt (1- beg-und))))
3189 (forward-line 1)))
3190 (t
3191 ;; An underline
3192 (setq key (concat (list ado-ch) "u"))
3193 (setq beg-und beg-pnt)
3194 (setq end-und end-pnt)
3195 (setq end-txt (1- beg-und))
3196 (setq beg-txt (progn
3197 (if (re-search-backward "^\\s *$" 1 'move)
3198 (forward-line 1))
3199 (point)))))
3200 (list key
3201 (or beg-ovr beg-txt beg-und)
3202 (or end-und end-txt end-und)
3203 beg-ovr end-ovr beg-txt end-txt beg-und end-und)))))
3204
3205;; Handles adornments for font-locking section titles and transitions. Returns
3206;; three match groups. First and last match group matched pure overline /
3207;; underline adornment while second group matched section title text. Each
3208;; group may not exist.
3209(defun rst-font-lock-handle-adornment (limit)
3210 (let ((ado-pnt rst-font-lock-adornment-point))
3211 ;; May run only once - enforce this 3810 ;; May run only once - enforce this
3212 (setq rst-font-lock-adornment-point nil) 3811 (setq rst-font-lock-adornment-match nil)
3213 (if ado-pnt 3812 (when match
3214 (let* ((ado (rst-classify-adornment (match-string-no-properties 1) 3813 (set-match-data match)
3215 ado-pnt limit)) 3814 (goto-char (match-end 0))
3216 (key (car ado)) 3815 (put-text-property (match-beginning 0) (match-end 0)
3217 (mtc (cdr ado))) 3816 'font-lock-multiline t)
3218 (setq rst-font-lock-level (rst-adornment-level key t)) 3817 t)))
3219 (goto-char (nth 1 mtc))
3220 (put-text-property (nth 0 mtc) (nth 1 mtc) 'font-lock-multiline t)
3221 (set-match-data mtc)
3222 t))))
3223
3224
3225 3818
3226 3819
3227;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3820;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3228;; Support for conversion from within Emacs 3821;; Compilation
3229 3822
3230(defgroup rst-compile nil 3823(defgroup rst-compile nil
3231 "Settings for support of conversion of reStructuredText 3824 "Settings for support of conversion of reStructuredText
@@ -3254,6 +3847,8 @@ document with \\[rst-compile]."
3254An association list of the toolset to a list of the (command to use, 3847An association list of the toolset to a list of the (command to use,
3255extension of produced filename, options to the tool (nil or a 3848extension of produced filename, options to the tool (nil or a
3256string)) to be used for converting the document." 3849string)) to be used for converting the document."
3850 ;; FIXME: These are not options but symbols which may be referenced by
3851 ;; `rst-compile-*-toolset` below
3257 :type '(alist :options (html latex newlatex pseudoxml xml pdf s5) 3852 :type '(alist :options (html latex newlatex pseudoxml xml pdf s5)
3258 :key-type symbol 3853 :key-type symbol
3259 :value-type (list :tag "Specification" 3854 :value-type (list :tag "Specification"
@@ -3265,15 +3860,11 @@ string)) to be used for converting the document."
3265 :group 'rst 3860 :group 'rst
3266 :version "24.1") 3861 :version "24.1")
3267 3862
3268;; Note for Python programmers not familiar with association lists: you can set 3863;; FIXME: Must be `defcustom`
3269;; values in an alists like this, e.g. :
3270;; (setcdr (assq 'html rst-compile-toolsets)
3271;; '("rst2html.py" ".htm" "--stylesheet=/docutils.css"))
3272
3273
3274(defvar rst-compile-primary-toolset 'html 3864(defvar rst-compile-primary-toolset 'html
3275 "The default toolset for `rst-compile'.") 3865 "The default toolset for `rst-compile'.")
3276 3866
3867;; FIXME: Must be `defcustom`
3277(defvar rst-compile-secondary-toolset 'latex 3868(defvar rst-compile-secondary-toolset 'latex
3278 "The default toolset for `rst-compile' with a prefix argument.") 3869 "The default toolset for `rst-compile' with a prefix argument.")
3279 3870
@@ -3301,15 +3892,15 @@ string)) to be used for converting the document."
3301 3892
3302(require 'compile) 3893(require 'compile)
3303 3894
3304(defun rst-compile (&optional pfxarg) 3895(defun rst-compile (&optional use-alt)
3305 "Compile command to convert reST document into some output file. 3896 "Compile command to convert reST document into some output file.
3306Attempts to find configuration file, if it can, overrides the 3897Attempts to find configuration file, if it can, overrides the
3307options. There are two commands to choose from, with a prefix 3898options. There are two commands to choose from, with USE-ALT,
3308argument, select the alternative toolset." 3899select the alternative toolset."
3309 (interactive "P") 3900 (interactive "P")
3310 ;; Note: maybe we want to check if there is a Makefile too and not do anything 3901 ;; Note: maybe we want to check if there is a Makefile too and not do anything
3311 ;; if that is the case. I dunno. 3902 ;; if that is the case. I dunno.
3312 (let* ((toolset (cdr (assq (if pfxarg 3903 (let* ((toolset (cdr (assq (if use-alt
3313 rst-compile-secondary-toolset 3904 rst-compile-secondary-toolset
3314 rst-compile-primary-toolset) 3905 rst-compile-primary-toolset)
3315 rst-compile-toolsets))) 3906 rst-compile-toolsets)))
@@ -3326,14 +3917,14 @@ argument, select the alternative toolset."
3326 (list command 3917 (list command
3327 (or options "") 3918 (or options "")
3328 (if conffile 3919 (if conffile
3329 (concat "--config=\"" conffile "\"") 3920 (concat "--config=" (shell-quote-argument conffile))
3330 "") 3921 "")
3331 bufname 3922 (shell-quote-argument bufname)
3332 (concat outname extension)) 3923 (shell-quote-argument (concat outname extension)))
3333 " ")) 3924 " "))
3334 3925
3335 ;; Invoke the compile command. 3926 ;; Invoke the compile command.
3336 (if (or compilation-read-command current-prefix-arg) 3927 (if (or compilation-read-command use-alt)
3337 (call-interactively 'compile) 3928 (call-interactively 'compile)
3338 (compile compile-command)) 3929 (compile compile-command))
3339 )) 3930 ))
@@ -3341,7 +3932,7 @@ argument, select the alternative toolset."
3341(defun rst-compile-alt-toolset () 3932(defun rst-compile-alt-toolset ()
3342 "Compile command with the alternative toolset." 3933 "Compile command with the alternative toolset."
3343 (interactive) 3934 (interactive)
3344 (rst-compile 't)) 3935 (rst-compile t))
3345 3936
3346(defun rst-compile-pseudo-region () 3937(defun rst-compile-pseudo-region ()
3347 "Show the pseudo-XML rendering of the current active region, 3938 "Show the pseudo-XML rendering of the current active region,
@@ -3354,45 +3945,45 @@ or of the entire buffer, if the region is not selected."
3354 (cadr (assq 'pseudoxml rst-compile-toolsets)) 3945 (cadr (assq 'pseudoxml rst-compile-toolsets))
3355 standard-output))) 3946 standard-output)))
3356 3947
3948;; FIXME: Should be `defcustom`
3357(defvar rst-pdf-program "xpdf" 3949(defvar rst-pdf-program "xpdf"
3358 "Program used to preview PDF files.") 3950 "Program used to preview PDF files.")
3359 3951
3360(defun rst-compile-pdf-preview () 3952(defun rst-compile-pdf-preview ()
3361 "Convert the document to a PDF file and launch a preview program." 3953 "Convert the document to a PDF file and launch a preview program."
3362 (interactive) 3954 (interactive)
3363 (let* ((tmp-filename (make-temp-file "rst-out" nil ".pdf")) 3955 (let* ((tmp-filename (make-temp-file "rst_el" nil ".pdf"))
3364 (command (format "%s %s %s && %s %s" 3956 (command (format "%s %s %s && %s %s ; rm %s"
3365 (cadr (assq 'pdf rst-compile-toolsets)) 3957 (cadr (assq 'pdf rst-compile-toolsets))
3366 buffer-file-name tmp-filename 3958 buffer-file-name tmp-filename
3367 rst-pdf-program tmp-filename))) 3959 rst-pdf-program tmp-filename tmp-filename)))
3368 (start-process-shell-command "rst-pdf-preview" nil command) 3960 (start-process-shell-command "rst-pdf-preview" nil command)
3369 ;; Note: you could also use (compile command) to view the compilation 3961 ;; Note: you could also use (compile command) to view the compilation
3370 ;; output. 3962 ;; output.
3371 )) 3963 ))
3372 3964
3965;; FIXME: Should be `defcustom` or use something like `browse-url`
3373(defvar rst-slides-program "firefox" 3966(defvar rst-slides-program "firefox"
3374 "Program used to preview S5 slides.") 3967 "Program used to preview S5 slides.")
3375 3968
3376(defun rst-compile-slides-preview () 3969(defun rst-compile-slides-preview ()
3377 "Convert the document to an S5 slide presentation and launch a preview program." 3970 "Convert the document to an S5 slide presentation and launch a preview program."
3378 (interactive) 3971 (interactive)
3379 (let* ((tmp-filename (make-temp-file "rst-slides" nil ".html")) 3972 (let* ((tmp-filename (make-temp-file "rst_el" nil ".html"))
3380 (command (format "%s %s %s && %s %s" 3973 (command (format "%s %s %s && %s %s ; rm %s"
3381 (cadr (assq 's5 rst-compile-toolsets)) 3974 (cadr (assq 's5 rst-compile-toolsets))
3382 buffer-file-name tmp-filename 3975 buffer-file-name tmp-filename
3383 rst-slides-program tmp-filename))) 3976 rst-slides-program tmp-filename tmp-filename)))
3384 (start-process-shell-command "rst-slides-preview" nil command) 3977 (start-process-shell-command "rst-slides-preview" nil command)
3385 ;; Note: you could also use (compile command) to view the compilation 3978 ;; Note: you could also use (compile command) to view the compilation
3386 ;; output. 3979 ;; output.
3387 )) 3980 ))
3388 3981
3389
3390 3982
3391;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3983;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3392;;
3393;; Generic text functions that are more convenient than the defaults. 3984;; Generic text functions that are more convenient than the defaults.
3394;;
3395 3985
3986;; FIXME: Unbound command - should be bound or removed
3396(defun rst-replace-lines (fromchar tochar) 3987(defun rst-replace-lines (fromchar tochar)
3397 "Replace flush-left lines, consisting of multiple FROMCHAR characters, 3988 "Replace flush-left lines, consisting of multiple FROMCHAR characters,
3398with equal-length lines of TOCHAR." 3989with equal-length lines of TOCHAR."
@@ -3400,7 +3991,7 @@ with equal-length lines of TOCHAR."
3400cSearch for flush-left lines of char: 3991cSearch for flush-left lines of char:
3401cand replace with char: ") 3992cand replace with char: ")
3402 (save-excursion 3993 (save-excursion
3403 (let ((searchre (concat "^" (regexp-quote (string fromchar)) "+\\( *\\)$")) 3994 (let ((searchre (rst-re "^" fromchar "+\\( *\\)$"))
3404 (found 0)) 3995 (found 0))
3405 (while (search-forward-regexp searchre nil t) 3996 (while (search-forward-regexp searchre nil t)
3406 (setq found (1+ found)) 3997 (setq found (1+ found))
@@ -3410,12 +4001,14 @@ cand replace with char: ")
3410 (insert-char tochar width))) 4001 (insert-char tochar width)))
3411 (message (format "%d lines replaced." found))))) 4002 (message (format "%d lines replaced." found)))))
3412 4003
4004;; FIXME: Unbound command - should be bound or removed
3413(defun rst-join-paragraph () 4005(defun rst-join-paragraph ()
3414 "Join lines in current paragraph into one line, removing end-of-lines." 4006 "Join lines in current paragraph into one line, removing end-of-lines."
3415 (interactive) 4007 (interactive)
3416 (let ((fill-column 65000)) ; some big number 4008 (let ((fill-column 65000)) ; some big number
3417 (call-interactively 'fill-paragraph))) 4009 (call-interactively 'fill-paragraph)))
3418 4010
4011;; FIXME: Unbound command - should be bound or removed
3419(defun rst-force-fill-paragraph () 4012(defun rst-force-fill-paragraph ()
3420 "Fill paragraph at point, first joining the paragraph's lines into one. 4013 "Fill paragraph at point, first joining the paragraph's lines into one.
3421This is useful for filling list item paragraphs." 4014This is useful for filling list item paragraphs."
@@ -3424,41 +4017,40 @@ This is useful for filling list item paragraphs."
3424 (fill-paragraph nil)) 4017 (fill-paragraph nil))
3425 4018
3426 4019
4020;; FIXME: Unbound command - should be bound or removed
3427;; Generic character repeater function. 4021;; Generic character repeater function.
3428;; For sections, better to use the specialized function above, but this can 4022;; For sections, better to use the specialized function above, but this can
3429;; be useful for creating separators. 4023;; be useful for creating separators.
3430(defun rst-repeat-last-character (&optional tofill) 4024(defun rst-repeat-last-character (use-next)
3431 "Fill the current line up to the length of the preceding line (if not 4025 "Fill the current line up to the length of the preceding line (if not
3432empty), using the last character on the current line. If the preceding line is 4026empty), using the last character on the current line. If the preceding line is
3433empty, we use the `fill-column'. 4027empty, we use the `fill-column'.
3434 4028
3435If a prefix argument is provided, use the next line rather than the preceding 4029If USE-NEXT, use the next line rather than the preceding line.
3436line.
3437 4030
3438If the current line is longer than the desired length, shave the characters off 4031If the current line is longer than the desired length, shave the characters off
3439the current line to fit the desired length. 4032the current line to fit the desired length.
3440 4033
3441As an added convenience, if the command is repeated immediately, the alternative 4034As an added convenience, if the command is repeated immediately, the alternative
3442column is used (fill-column vs. end of previous/next line)." 4035column is used (fill-column vs. end of previous/next line)."
3443 (interactive) 4036 (interactive "P")
3444 (let* ((curcol (current-column)) 4037 (let* ((curcol (current-column))
3445 (curline (+ (count-lines (point-min) (point)) 4038 (curline (+ (count-lines (point-min) (point))
3446 (if (eq curcol 0) 1 0))) 4039 (if (zerop curcol) 1 0)))
3447 (lbp (line-beginning-position 0)) 4040 (lbp (line-beginning-position 0))
3448 (prevcol (if (and (= curline 1) (not current-prefix-arg)) 4041 (prevcol (if (and (= curline 1) (not use-next))
3449 fill-column 4042 fill-column
3450 (save-excursion 4043 (save-excursion
3451 (forward-line (if current-prefix-arg 1 -1)) 4044 (forward-line (if use-next 1 -1))
3452 (end-of-line) 4045 (end-of-line)
3453 (skip-chars-backward " \t" lbp) 4046 (skip-chars-backward " \t" lbp)
3454 (let ((cc (current-column))) 4047 (let ((cc (current-column)))
3455 (if (= cc 0) fill-column cc))))) 4048 (if (zerop cc) fill-column cc)))))
3456 (rightmost-column 4049 (rightmost-column
3457 (cond (tofill fill-column) 4050 (cond ((equal last-command 'rst-repeat-last-character)
3458 ((equal last-command 'rst-repeat-last-character)
3459 (if (= curcol fill-column) prevcol fill-column)) 4051 (if (= curcol fill-column) prevcol fill-column))
3460 (t (save-excursion 4052 (t (save-excursion
3461 (if (= prevcol 0) fill-column prevcol))) 4053 (if (zerop prevcol) fill-column prevcol)))
3462 )) ) 4054 )) )
3463 (end-of-line) 4055 (end-of-line)
3464 (if (> (current-column) rightmost-column) 4056 (if (> (current-column) rightmost-column)
@@ -3481,5 +4073,4 @@ column is used (fill-column vs. end of previous/next line)."
3481 4073
3482 4074
3483(provide 'rst) 4075(provide 'rst)
3484
3485;;; rst.el ends here 4076;;; rst.el ends here