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