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