diff options
| author | Stefan Merten | 2016-07-31 16:40:46 +0200 |
|---|---|---|
| committer | Stefan Merten | 2016-07-31 16:40:46 +0200 |
| commit | cafb4a391b74e193d5807348fb3ee849c6acdde9 (patch) | |
| tree | 3514d31f67798efd8c95ee45f28907d45ac7b506 | |
| parent | 8cbaf342538fe49f6f064f65717672f8eeb83750 (diff) | |
| download | emacs-cafb4a391b74e193d5807348fb3ee849c6acdde9.tar.gz emacs-cafb4a391b74e193d5807348fb3ee849c6acdde9.zip | |
* lisp/textmodes/rst.el: Major refactoring, minor changes, minor fixes
(rst-Ado, rst-Hdr, rst-Ttl, rst-Stn): Introduce classes
representing reStructuredText section header concepts.
(rst-mode-map, rst-new-preferred-hdr)
(rst-update-section, rst-classify-adornment)
(rst-ttl-at-point, rst-all-ttls-cache)
(rst-hdr-hierarchy-cache, rst-reset-section-caches)
(rst-all-ttls, rst-infer-hdr-hierarchy, rst-hdr-hierarchy)
(rst-all-ttls-with-level, rst-get-previous-hdr)
(rst-adornment-complete-p, rst-next-hdr, rst-adjust)
(rst-adjust-section, rst-promote-region)
(rst-display-hdr-hierarchy, rst-straighten-sections)
(rst-all-stn, rst-remaining-stn, rst-toc-insert)
(rst-toc-insert-node, rst-toc-node, rst-toc)
(rst-forward-section, rst-adornment-level)
(rst-font-lock-handle-adornment-pre-match-form)
(rst-imenu-convert-cell, rst-imenu-create-index): Refactor
using classes.
(rst-compare-adornments, rst-get-adornment-match): Remove
functions now in classes.
(rst-re-alist-def, rst-toc-mode)
(rst-font-lock-extend-region-extend): Minor improvements.
(rst-mode, rst-compile): Use `setq-local'.
(rst-cvs-header, rst-svn-rev, rst-svn-timestamp)
(rst-official-version, rst-official-cvs-rev)
(rst-package-emacs-version-alist): Maintain version tags.
| -rw-r--r-- | lisp/textmodes/rst.el | 2772 |
1 files changed, 1558 insertions, 1214 deletions
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 3d4854e89d6..ed2075caca0 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el | |||
| @@ -2,8 +2,8 @@ | |||
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2003-2016 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2003-2016 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Maintainer: Stefan Merten <smerten@oekonux.de> | 5 | ;; Maintainer: Stefan Merten <stefan at merten-home dot de> |
| 6 | ;; Author: Stefan Merten <smerten@oekonux.de>, | 6 | ;; Author: Stefan Merten <stefan at merten-home dot de>, |
| 7 | ;; Martin Blais <blais@furius.ca>, | 7 | ;; Martin Blais <blais@furius.ca>, |
| 8 | ;; David Goodger <goodger@python.org>, | 8 | ;; David Goodger <goodger@python.org>, |
| 9 | ;; Wei-Wei Guo <wwguocn@gmail.com> | 9 | ;; Wei-Wei Guo <wwguocn@gmail.com> |
| @@ -53,10 +53,10 @@ | |||
| 53 | ;; For full details on how to use the contents of this file, see | 53 | ;; For full details on how to use the contents of this file, see |
| 54 | ;; http://docutils.sourceforge.net/docs/user/emacs.html | 54 | ;; http://docutils.sourceforge.net/docs/user/emacs.html |
| 55 | ;; | 55 | ;; |
| 56 | ;; | 56 | ;; There are a number of convenient key bindings provided by rst-mode. For the |
| 57 | ;; There are a number of convenient key bindings provided by rst-mode. | 57 | ;; bindings, try C-c C-h when in rst-mode. There are also many variables that |
| 58 | ;; For more on bindings, see rst-mode-map below. There are also many variables | 58 | ;; can be customized, look for defcustom in this file or look for the "rst" |
| 59 | ;; that can be customized, look for defcustom in this file. | 59 | ;; customization group contained in the "wp" group. |
| 60 | ;; | 60 | ;; |
| 61 | ;; If you use the table-of-contents feature, you may want to add a hook to | 61 | ;; If you use the table-of-contents feature, you may want to add a hook to |
| 62 | ;; update the TOC automatically every time you adjust a section title:: | 62 | ;; update the TOC automatically every time you adjust a section title:: |
| @@ -68,11 +68,6 @@ | |||
| 68 | ;; | 68 | ;; |
| 69 | ;; (setq font-lock-global-modes '(not rst-mode ...)) | 69 | ;; (setq font-lock-global-modes '(not rst-mode ...)) |
| 70 | ;; | 70 | ;; |
| 71 | ;; | ||
| 72 | ;; | ||
| 73 | ;; Customization is done by customizable variables contained in customization | ||
| 74 | ;; group "rst" and subgroups. Group "rst" is contained in the "wp" group. | ||
| 75 | ;; | ||
| 76 | 71 | ||
| 77 | ;;; DOWNLOAD | 72 | ;;; DOWNLOAD |
| 78 | 73 | ||
| @@ -110,10 +105,10 @@ | |||
| 110 | ;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*- | 105 | ;; FIXME: When 24.1 is common place remove use of `lexical-let' and put "-*- |
| 111 | ;; lexical-binding: t -*-" in the first line. | 106 | ;; lexical-binding: t -*-" in the first line. |
| 112 | 107 | ||
| 113 | ;; FIXME: Use `testcover'. | 108 | ;; FIXME: Embed complicated `defconst's in `eval-when-compile'. |
| 114 | 109 | ||
| 115 | ;; FIXME: The adornment classification often called `ado' should be a | 110 | ;; FIXME: Use `testcover'. Mark up a function with sufficient test coverage by |
| 116 | ;; `defstruct'. | 111 | ;; a comment tagged with `testcover' after the `defun'. |
| 117 | 112 | ||
| 118 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 113 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 119 | ;; Support for `testcover' | 114 | ;; Support for `testcover' |
| @@ -160,6 +155,7 @@ considered constants. Revert it with this function after each `defcustom'." | |||
| 160 | ;; used from there. | 155 | ;; used from there. |
| 161 | 156 | ||
| 162 | (defun rst-signum (x) | 157 | (defun rst-signum (x) |
| 158 | ;; testcover: ok. | ||
| 163 | "Return 1 if X is positive, -1 if negative, 0 if zero." | 159 | "Return 1 if X is positive, -1 if negative, 0 if zero." |
| 164 | (cond | 160 | (cond |
| 165 | ((> x 0) 1) | 161 | ((> x 0) 1) |
| @@ -167,6 +163,7 @@ considered constants. Revert it with this function after each `defcustom'." | |||
| 167 | (t 0))) | 163 | (t 0))) |
| 168 | 164 | ||
| 169 | (defun rst-some (seq &optional pred) | 165 | (defun rst-some (seq &optional pred) |
| 166 | ;; testcover: ok. | ||
| 170 | "Return non-nil if any element of SEQ yields non-nil when PRED is applied. | 167 | "Return non-nil if any element of SEQ yields non-nil when PRED is applied. |
| 171 | Apply PRED to each element of list SEQ until the first non-nil | 168 | Apply PRED to each element of list SEQ until the first non-nil |
| 172 | result is yielded and return this result. PRED defaults to | 169 | result is yielded and return this result. PRED defaults to |
| @@ -180,6 +177,7 @@ result is yielded and return this result. PRED defaults to | |||
| 180 | (throw 'rst-some r)))))) | 177 | (throw 'rst-some r)))))) |
| 181 | 178 | ||
| 182 | (defun rst-position-if (pred seq) | 179 | (defun rst-position-if (pred seq) |
| 180 | ;; testcover: ok. | ||
| 183 | "Return position of first element satisfying PRED in list SEQ or nil." | 181 | "Return position of first element satisfying PRED in list SEQ or nil." |
| 184 | (catch 'rst-position-if | 182 | (catch 'rst-position-if |
| 185 | (let ((i 0)) | 183 | (let ((i 0)) |
| @@ -189,6 +187,7 @@ result is yielded and return this result. PRED defaults to | |||
| 189 | (incf i))))) | 187 | (incf i))))) |
| 190 | 188 | ||
| 191 | (defun rst-position (elem seq) | 189 | (defun rst-position (elem seq) |
| 190 | ;; testcover: ok. | ||
| 192 | "Return position of ELEM in list SEQ or nil. | 191 | "Return position of ELEM in list SEQ or nil. |
| 193 | Comparison done with `equal'." | 192 | Comparison done with `equal'." |
| 194 | ;; Create a closure containing `elem' so the `lambda' always sees our | 193 | ;; Create a closure containing `elem' so the `lambda' always sees our |
| @@ -199,13 +198,22 @@ Comparison done with `equal'." | |||
| 199 | (equal elem e))) | 198 | (equal elem e))) |
| 200 | seq))) | 199 | seq))) |
| 201 | 200 | ||
| 202 | ;; FIXME: Embed complicated `defconst's in `eval-when-compile'. | 201 | (defun rst-member-if (pred seq) |
| 202 | ;; testcover: ok. | ||
| 203 | "Return sublist of SEQ starting with the element whose car satisfies PRED." | ||
| 204 | (let (found) | ||
| 205 | (while (and (not found) seq) | ||
| 206 | (if (funcall pred (car seq)) | ||
| 207 | (setq found seq) | ||
| 208 | (setq seq (cdr seq)))) | ||
| 209 | found)) | ||
| 203 | 210 | ||
| 211 | |||
| 204 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 212 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 205 | ;; Versions | 213 | ;; Versions |
| 206 | 214 | ||
| 207 | ;; testcover: ok. | ||
| 208 | (defun rst-extract-version (delim-re head-re re tail-re var &optional default) | 215 | (defun rst-extract-version (delim-re head-re re tail-re var &optional default) |
| 216 | ;; testcover: ok. | ||
| 209 | "Extract the version from a variable according to the given regexes. | 217 | "Extract the version from a variable according to the given regexes. |
| 210 | Return the version after regex DELIM-RE and HEAD-RE matching RE | 218 | Return the version after regex DELIM-RE and HEAD-RE matching RE |
| 211 | and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." | 219 | and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." |
| @@ -218,7 +226,7 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." | |||
| 218 | ;; Use CVSHeader to really get information from CVS and not other version | 226 | ;; Use CVSHeader to really get information from CVS and not other version |
| 219 | ;; control systems. | 227 | ;; control systems. |
| 220 | (defconst rst-cvs-header | 228 | (defconst rst-cvs-header |
| 221 | "$CVSHeader: sm/rst_el/rst.el,v 1.327.2.26 2015/10/04 09:26:04 stefan Exp $") | 229 | "$CVSHeader: sm/rst_el/rst.el,v 1.600 2016/07/31 11:13:44 stefan Exp $") |
| 222 | (defconst rst-cvs-rev | 230 | (defconst rst-cvs-rev |
| 223 | (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" | 231 | (rst-extract-version "\\$" "CVSHeader: \\S + " "[0-9]+\\(?:\\.[0-9]+\\)+" |
| 224 | " .*" rst-cvs-header "0.0") | 232 | " .*" rst-cvs-header "0.0") |
| @@ -232,22 +240,22 @@ and before TAIL-RE and DELIM-RE in VAR or DEFAULT for no match." | |||
| 232 | ;; Use LastChanged... to really get information from SVN. | 240 | ;; Use LastChanged... to really get information from SVN. |
| 233 | (defconst rst-svn-rev | 241 | (defconst rst-svn-rev |
| 234 | (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " " | 242 | (rst-extract-version "\\$" "LastChangedRevision: " "[0-9]+" " " |
| 235 | "$LastChangedRevision: 7925 $") | 243 | "$LastChangedRevision: 7963 $") |
| 236 | "The SVN revision of this file. | 244 | "The SVN revision of this file. |
| 237 | SVN revision is the upstream (docutils) revision.") | 245 | SVN revision is the upstream (docutils) revision.") |
| 238 | (defconst rst-svn-timestamp | 246 | (defconst rst-svn-timestamp |
| 239 | (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " " | 247 | (rst-extract-version "\\$" "LastChangedDate: " ".+?+" " " |
| 240 | "$LastChangedDate: 2015-10-04 11:21:35 +0200 (Sun, 04 Oct 2015) $") | 248 | "$LastChangedDate: 2016-07-31 13:13:21 +0200 (Sun, 31 Jul 2016) $") |
| 241 | "The SVN time stamp of this file.") | 249 | "The SVN time stamp of this file.") |
| 242 | 250 | ||
| 243 | ;; Maintained by the release process. | 251 | ;; Maintained by the release process. |
| 244 | (defconst rst-official-version | 252 | (defconst rst-official-version |
| 245 | (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " | 253 | (rst-extract-version "%" "OfficialVersion: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " |
| 246 | "%OfficialVersion: 1.4.1 %") | 254 | "%OfficialVersion: 1.5.0 %") |
| 247 | "Official version of the package.") | 255 | "Official version of the package.") |
| 248 | (defconst rst-official-cvs-rev | 256 | (defconst rst-official-cvs-rev |
| 249 | (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " | 257 | (rst-extract-version "[%$]" "Revision: " "[0-9]+\\(?:\\.[0-9]+\\)+" " " |
| 250 | "%Revision: 1.327.2.25 %") | 258 | "%Revision: 1.600 %") |
| 251 | "CVS revision of this file in the official version.") | 259 | "CVS revision of this file in the official version.") |
| 252 | 260 | ||
| 253 | (defconst rst-version | 261 | (defconst rst-version |
| @@ -268,6 +276,8 @@ in parentheses follows the development revision and the time stamp.") | |||
| 268 | ("1.3.1" . "24.3") | 276 | ("1.3.1" . "24.3") |
| 269 | ("1.4.0" . "24.3") | 277 | ("1.4.0" . "24.3") |
| 270 | ("1.4.1" . "24.5") | 278 | ("1.4.1" . "24.5") |
| 279 | ("1.4.2" . "24.5") | ||
| 280 | ("1.5.0" . "25.2") | ||
| 271 | )) | 281 | )) |
| 272 | 282 | ||
| 273 | (unless (assoc rst-official-version rst-package-emacs-version-alist) | 283 | (unless (assoc rst-official-version rst-package-emacs-version-alist) |
| @@ -277,10 +287,10 @@ in parentheses follows the development revision and the time stamp.") | |||
| 277 | (add-to-list 'customize-package-emacs-version-alist | 287 | (add-to-list 'customize-package-emacs-version-alist |
| 278 | (cons 'ReST rst-package-emacs-version-alist)) | 288 | (cons 'ReST rst-package-emacs-version-alist)) |
| 279 | 289 | ||
| 290 | |||
| 280 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 291 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 281 | ;; Initialize customization | 292 | ;; Initialize customization |
| 282 | 293 | ||
| 283 | |||
| 284 | (defgroup rst nil "Support for reStructuredText documents." | 294 | (defgroup rst nil "Support for reStructuredText documents." |
| 285 | :group 'wp | 295 | :group 'wp |
| 286 | :version "23.1" | 296 | :version "23.1" |
| @@ -490,8 +500,10 @@ in parentheses follows the development revision and the time stamp.") | |||
| 490 | ; character. | 500 | ; character. |
| 491 | 501 | ||
| 492 | ;; Titles (`ttl') | 502 | ;; Titles (`ttl') |
| 493 | (ttl-tag "\\S *\\w\\S *") ; A title text. | 503 | (ttl-tag "\\S *\\w.*\\S ") ; A title text. |
| 494 | (ttl-beg lin-beg ttl-tag) ; A title text at the beginning of a line. | 504 | (ttl-beg-1 lin-beg (:grp ttl-tag)) ; A title text at the beginning of a |
| 505 | ; line. First group is the complete, | ||
| 506 | ; trimmed title text. | ||
| 495 | 507 | ||
| 496 | ;; Directives and substitution definitions (`dir') | 508 | ;; Directives and substitution definitions (`dir') |
| 497 | (dir-tag-3 (:grp exm-sta) | 509 | (dir-tag-3 (:grp exm-sta) |
| @@ -531,8 +543,8 @@ argument list for `rst-re'.") | |||
| 531 | 543 | ||
| 532 | ;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel. | 544 | ;; FIXME: Use `sregex' or `rx' instead of re-inventing the wheel. |
| 533 | (rst-testcover-add-compose 'rst-re) | 545 | (rst-testcover-add-compose 'rst-re) |
| 534 | ;; testcover: ok. | ||
| 535 | (defun rst-re (&rest args) | 546 | (defun rst-re (&rest args) |
| 547 | ;; testcover: ok. | ||
| 536 | "Interpret ARGS as regular expressions and return a regex string. | 548 | "Interpret ARGS as regular expressions and return a regex string. |
| 537 | Each element of ARGS may be one of the following: | 549 | Each element of ARGS may be one of the following: |
| 538 | 550 | ||
| @@ -603,10 +615,579 @@ After interpretation of ARGS the results are concatenated as for | |||
| 603 | 615 | ||
| 604 | 616 | ||
| 605 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 617 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 618 | ;; Concepts | ||
| 619 | |||
| 620 | ;; Each of the following classes represents an own concept. The suffix of the | ||
| 621 | ;; class name is used in the code to represent entities of the respective | ||
| 622 | ;; class. | ||
| 623 | ;; | ||
| 624 | ;; In addition a reStructuredText section header in the buffer is called | ||
| 625 | ;; "section". | ||
| 626 | ;; | ||
| 627 | ;; For lists a "s" is added to the name of the concepts. | ||
| 628 | |||
| 629 | |||
| 630 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 631 | ;; Class rst-Ado | ||
| 632 | |||
| 633 | (defstruct | ||
| 634 | (rst-Ado | ||
| 635 | (:constructor nil) ;; Prevent creating unchecked values. | ||
| 636 | ;; Construct a transition. | ||
| 637 | (:constructor | ||
| 638 | rst-Ado-new-transition | ||
| 639 | (&aux | ||
| 640 | (char nil) | ||
| 641 | (-style 'transition))) | ||
| 642 | ;; Construct a simple section header. | ||
| 643 | (:constructor | ||
| 644 | rst-Ado-new-simple | ||
| 645 | (char-arg | ||
| 646 | &aux | ||
| 647 | (char (rst-Ado--validate-char char-arg)) | ||
| 648 | (-style 'simple))) | ||
| 649 | ;; Construct a over-and-under section header. | ||
| 650 | (:constructor | ||
| 651 | rst-Ado-new-over-and-under | ||
| 652 | (char-arg | ||
| 653 | &aux | ||
| 654 | (char (rst-Ado--validate-char char-arg)) | ||
| 655 | (-style 'over-and-under))) | ||
| 656 | ;; Construct from adornment with inverted style. | ||
| 657 | (:constructor | ||
| 658 | rst-Ado-new-invert | ||
| 659 | (ado-arg | ||
| 660 | &aux | ||
| 661 | (char (rst-Ado-char ado-arg)) | ||
| 662 | (-style (let ((sty (rst-Ado--style ado-arg))) | ||
| 663 | (cond | ||
| 664 | ((eq sty 'simple) | ||
| 665 | 'over-and-under) | ||
| 666 | ((eq sty 'over-and-under) | ||
| 667 | 'simple) | ||
| 668 | (sty))))))) | ||
| 669 | "Representation of a reStructuredText adornment. | ||
| 670 | Adornments are either section markers where they markup the | ||
| 671 | section header or transitions. | ||
| 672 | |||
| 673 | This type is immutable." | ||
| 674 | ;; The character used for the adornment. | ||
| 675 | (char nil :read-only t) | ||
| 676 | ;; The style of the adornment. This is a private attribute. | ||
| 677 | (-style nil :read-only t)) | ||
| 678 | |||
| 679 | ;; Private class methods | ||
| 680 | |||
| 681 | (defun rst-Ado--validate-char (char) | ||
| 682 | ;; testcover: ok. | ||
| 683 | "Validate CHAR to be a valid adornment character. | ||
| 684 | Return CHAR if so or signal an error otherwise." | ||
| 685 | (cond | ||
| 686 | ((not (characterp char)) | ||
| 687 | (signal 'wrong-type-argument (list 'characterp char))) | ||
| 688 | ((memq char rst-adornment-chars) | ||
| 689 | char) | ||
| 690 | (t | ||
| 691 | (signal 'args-out-of-range | ||
| 692 | (list (format | ||
| 693 | "Character must be a valid adornment character, not '%s'" | ||
| 694 | char)))))) | ||
| 695 | |||
| 696 | ;; Public methods | ||
| 697 | |||
| 698 | (defun rst-Ado-is-transition (self) | ||
| 699 | ;; testcover: ok. | ||
| 700 | "Return non-nil if SELF is a transition adornment." | ||
| 701 | (unless (rst-Ado-p self) | ||
| 702 | (signal 'wrong-type-argument | ||
| 703 | (list 'rst-Ado-p self))) | ||
| 704 | (eq (rst-Ado--style self) 'transition)) | ||
| 705 | |||
| 706 | (defun rst-Ado-is-section (self) | ||
| 707 | ;; testcover: ok. | ||
| 708 | "Return non-nil if SELF is a section adornment." | ||
| 709 | (unless (rst-Ado-p self) | ||
| 710 | (signal 'wrong-type-argument | ||
| 711 | (list 'rst-Ado-p self))) | ||
| 712 | (not (rst-Ado-is-transition self))) | ||
| 713 | |||
| 714 | (defun rst-Ado-is-simple (self) | ||
| 715 | ;; testcover: ok. | ||
| 716 | "Return non-nil if SELF is a simple section adornment." | ||
| 717 | (unless (rst-Ado-p self) | ||
| 718 | (signal 'wrong-type-argument | ||
| 719 | (list 'rst-Ado-p self))) | ||
| 720 | (eq (rst-Ado--style self) 'simple)) | ||
| 721 | |||
| 722 | (defun rst-Ado-is-over-and-under (self) | ||
| 723 | ;; testcover: ok. | ||
| 724 | "Return non-nil if SELF is a over-and-under section adornment." | ||
| 725 | (unless (rst-Ado-p self) | ||
| 726 | (signal 'wrong-type-argument | ||
| 727 | (list 'rst-Ado-p self))) | ||
| 728 | (eq (rst-Ado--style self) 'over-and-under)) | ||
| 729 | |||
| 730 | (defun rst-Ado-equal (self other) | ||
| 731 | ;; testcover: ok. | ||
| 732 | "Return non-nil when SELF and OTHER are equal." | ||
| 733 | (cond | ||
| 734 | ((not (rst-Ado-p self)) | ||
| 735 | (signal 'wrong-type-argument | ||
| 736 | (list 'rst-Ado-p self))) | ||
| 737 | ((not (rst-Ado-p other)) | ||
| 738 | (signal 'wrong-type-argument | ||
| 739 | (list 'rst-Ado-p other))) | ||
| 740 | ((not (eq (rst-Ado--style self) (rst-Ado--style other))) | ||
| 741 | nil) | ||
| 742 | ((rst-Ado-is-transition self)) | ||
| 743 | ((equal (rst-Ado-char self) (rst-Ado-char other))))) | ||
| 744 | |||
| 745 | (defun rst-Ado-position (self ados) | ||
| 746 | ;; testcover: ok. | ||
| 747 | "Return position of of SELF in ADOS or nil." | ||
| 748 | (unless (rst-Ado-p self) | ||
| 749 | (signal 'wrong-type-argument | ||
| 750 | (list 'rst-Ado-p self))) | ||
| 751 | (lexical-let ((ado self)) ;; Create closure. | ||
| 752 | (rst-position-if (function (lambda (e) | ||
| 753 | (rst-Ado-equal ado e))) | ||
| 754 | ados))) | ||
| 755 | |||
| 756 | |||
| 757 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 758 | ;; Class rst-Hdr | ||
| 759 | |||
| 760 | (defstruct | ||
| 761 | (rst-Hdr | ||
| 762 | (:constructor nil) ;; Prevent creating unchecked values. | ||
| 763 | ;; Construct while all parameters must be valid. | ||
| 764 | (:constructor | ||
| 765 | rst-Hdr-new | ||
| 766 | (ado-arg | ||
| 767 | indent-arg | ||
| 768 | &aux | ||
| 769 | (ado (rst-Hdr--validate-ado ado-arg)) | ||
| 770 | (indent (rst-Hdr--validate-indent indent-arg ado nil)))) | ||
| 771 | ;; Construct while all parameters but `indent' must be valid. | ||
| 772 | (:constructor | ||
| 773 | rst-Hdr-new-lax | ||
| 774 | (ado-arg | ||
| 775 | indent-arg | ||
| 776 | &aux | ||
| 777 | (ado (rst-Hdr--validate-ado ado-arg)) | ||
| 778 | (indent (rst-Hdr--validate-indent indent-arg ado t)))) | ||
| 779 | ;; Construct a header with same characteristics but opposite style as `ado'. | ||
| 780 | (:constructor | ||
| 781 | rst-Hdr-new-invert | ||
| 782 | (ado-arg | ||
| 783 | indent-arg | ||
| 784 | &aux | ||
| 785 | (ado (rst-Hdr--validate-ado (rst-Ado-new-invert ado-arg))) | ||
| 786 | (indent (rst-Hdr--validate-indent indent-arg ado t)))) | ||
| 787 | (:copier rst-Hdr-copy)) ;; Not really needed for an immutable type. | ||
| 788 | "Representation of reStructuredText section header characteristics. | ||
| 789 | |||
| 790 | This type is immutable." | ||
| 791 | ;; The adornment of the header. | ||
| 792 | (ado nil :read-only t) | ||
| 793 | ;; The indentation of a title text or nil if not given. | ||
| 794 | (indent nil :read-only t)) | ||
| 795 | |||
| 796 | ;; Private class methods | ||
| 797 | |||
| 798 | (defun rst-Hdr--validate-indent (indent ado lax) | ||
| 799 | ;; testcover: ok. | ||
| 800 | "Validate INDENT to be a valid indentation for ADO. | ||
| 801 | Return INDENT if so or signal an error otherwise. If LAX don't | ||
| 802 | signal an error and return a valid indent." | ||
| 803 | (cond | ||
| 804 | ((not (integerp indent)) | ||
| 805 | (signal 'wrong-type-argument | ||
| 806 | (list 'integerp 'null indent))) | ||
| 807 | ((zerop indent) | ||
| 808 | indent) | ||
| 809 | ((rst-Ado-is-simple ado) | ||
| 810 | (if lax | ||
| 811 | 0 | ||
| 812 | (signal 'args-out-of-range | ||
| 813 | '("Indentation must be 0 for style simple")))) | ||
| 814 | ((< indent 0) | ||
| 815 | (if lax | ||
| 816 | 0 | ||
| 817 | (signal 'args-out-of-range | ||
| 818 | '("Indentation must not be negative")))) | ||
| 819 | (indent))) ;; Implicitly over-and-under. | ||
| 820 | |||
| 821 | (defun rst-Hdr--validate-ado (ado) | ||
| 822 | ;; testcover: ok. | ||
| 823 | "Validate ADO to be a valid adornment. | ||
| 824 | Return ADO if so or signal an error otherwise." | ||
| 825 | (cond | ||
| 826 | ((not (rst-Ado-p ado)) | ||
| 827 | (signal 'wrong-type-argument | ||
| 828 | (list 'rst-Ado-p ado))) | ||
| 829 | ((rst-Ado-is-transition ado) | ||
| 830 | (signal 'args-out-of-range | ||
| 831 | '("Adornment for header must not be transition."))) | ||
| 832 | (t | ||
| 833 | ado))) | ||
| 834 | |||
| 835 | ;; Public class methods | ||
| 836 | |||
| 837 | (defun rst-Hdr-preferred-adornments () | ||
| 838 | ;; testcover: ok. | ||
| 839 | "Return preferred adornments as list of `rst-Hdr'." | ||
| 840 | (mapcar (lambda (el) | ||
| 841 | (rst-Hdr-new-lax | ||
| 842 | (if (eq (cadr el) 'over-and-under) | ||
| 843 | (rst-Ado-new-over-and-under (car el)) | ||
| 844 | (rst-Ado-new-simple (car el))) | ||
| 845 | (caddr el))) | ||
| 846 | rst-preferred-adornments)) | ||
| 847 | |||
| 848 | ;; Public methods | ||
| 849 | |||
| 850 | (defun rst-Hdr-member-ado (self hdrs) | ||
| 851 | ;; testcover: ok. | ||
| 852 | "Return sublist of HDRS whose car's adornment equals that of SELF or nil." | ||
| 853 | (unless (rst-Hdr-p self) | ||
| 854 | (signal 'wrong-type-argument | ||
| 855 | (list 'rst-Hdr-p self))) | ||
| 856 | (let ((pos (rst-Ado-position (rst-Hdr-ado self) (rst-Hdr-ado-map hdrs)))) | ||
| 857 | (and pos (nthcdr pos hdrs)))) | ||
| 858 | |||
| 859 | (defun rst-Hdr-ado-map (selfs) | ||
| 860 | ;; testcover: ok. | ||
| 861 | "Return `rst-Ado' list extracted from elements of SELFS." | ||
| 862 | (mapcar 'rst-Hdr-ado selfs)) | ||
| 863 | |||
| 864 | (defun rst-Hdr-get-char (self) | ||
| 865 | ;; testcover: ok. | ||
| 866 | "Return character of the adornment of SELF." | ||
| 867 | (unless (rst-Hdr-p self) | ||
| 868 | (signal 'wrong-type-argument | ||
| 869 | (list 'rst-Hdr-p self))) | ||
| 870 | (rst-Ado-char (rst-Hdr-ado self))) | ||
| 871 | |||
| 872 | (defun rst-Hdr-is-over-and-under (self) | ||
| 873 | ;; testcover: ok. | ||
| 874 | "Return non-nil if SELF is a over-and-under section header." | ||
| 875 | (unless (rst-Hdr-p self) | ||
| 876 | (signal 'wrong-type-argument | ||
| 877 | (list 'rst-Hdr-p self))) | ||
| 878 | (rst-Ado-is-over-and-under (rst-Hdr-ado self))) | ||
| 879 | |||
| 880 | |||
| 881 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 882 | ;; Class rst-Ttl | ||
| 883 | |||
| 884 | (defstruct | ||
| 885 | (rst-Ttl | ||
| 886 | (:constructor nil) ;; Prevent creating unchecked values. | ||
| 887 | ;; Construct with valid parameters for all attributes. | ||
| 888 | (:constructor | ||
| 889 | rst-Ttl-new | ||
| 890 | (ado-arg | ||
| 891 | match-arg | ||
| 892 | indent-arg | ||
| 893 | text-arg | ||
| 894 | &optional | ||
| 895 | hdr-arg | ||
| 896 | level-arg | ||
| 897 | &aux | ||
| 898 | (ado (rst-Ttl--validate-ado ado-arg)) | ||
| 899 | (match (rst-Ttl--validate-match match-arg ado)) | ||
| 900 | (indent (rst-Ttl--validate-indent indent-arg ado)) | ||
| 901 | (text (rst-Ttl--validate-text text-arg ado)) | ||
| 902 | (hdr (and hdr-arg (rst-Ttl--validate-hdr hdr-arg ado indent))) | ||
| 903 | (level (and level-arg (rst-Ttl--validate-level level-arg))))) | ||
| 904 | (:copier rst-Ttl-copy)) | ||
| 905 | "Representation of a reStructuredText section header as found in the buffer. | ||
| 906 | This type gathers information about an adorned part in the | ||
| 907 | buffer. Thus only the basic attributes are immutable. Although | ||
| 908 | the remaining attributes are `setf'-able the respective setters | ||
| 909 | should be used." | ||
| 910 | ;; The adornment characteristics or nil for a title candidate. | ||
| 911 | (ado nil :read-only t) | ||
| 912 | ;; The match-data for `ado' as returned by `match-data'. Match group 0 | ||
| 913 | ;; matches the whole construct. Match group 1 matches the overline adornment | ||
| 914 | ;; if present. Match group 2 matches the section title text or the | ||
| 915 | ;; transition. Match group 3 matches the underline adornment. | ||
| 916 | (match nil :read-only t) | ||
| 917 | ;; An indentation found for the title line or nil for a transition. | ||
| 918 | (indent nil :read-only t) | ||
| 919 | ;; The text of the title or nil for a transition. | ||
| 920 | (text nil :read-only t) | ||
| 921 | ;; The header characteristics if it is a valid section header. | ||
| 922 | (hdr nil) | ||
| 923 | ;; The hierarchical level of the section header starting with 0. | ||
| 924 | (level nil)) | ||
| 925 | |||
| 926 | ;; Private class methods | ||
| 927 | |||
| 928 | (defun rst-Ttl--validate-ado (ado) | ||
| 929 | ;; testcover: ok. | ||
| 930 | "Return valid ADO or signal error." | ||
| 931 | (unless (or (null ado) (rst-Ado-p ado)) | ||
| 932 | (signal 'wrong-type-argument | ||
| 933 | (list 'null 'rst-Ado-p ado))) | ||
| 934 | ado) | ||
| 935 | |||
| 936 | (defun rst-Ttl--validate-match (match ado) | ||
| 937 | ;; testcover: ok. | ||
| 938 | "Return valid MATCH matching ADO or signal error." | ||
| 939 | (unless (listp match) | ||
| 940 | (signal 'wrong-type-argument | ||
| 941 | (list 'listp match))) | ||
| 942 | (unless (equal (length match) 8) | ||
| 943 | (signal 'args-out-of-range | ||
| 944 | '("Match data must consist of exactly 8 buffer positions."))) | ||
| 945 | (mapcar (lambda (pos) | ||
| 946 | (unless (or (null pos) (integer-or-marker-p pos)) | ||
| 947 | (signal 'wrong-type-argument | ||
| 948 | (list 'integer-or-marker-p 'null pos)))) | ||
| 949 | match) | ||
| 950 | (unless (and (integer-or-marker-p (nth 0 match)) | ||
| 951 | (integer-or-marker-p (nth 1 match))) | ||
| 952 | (signal 'args-out-of-range | ||
| 953 | '("First two elements of match data must be buffer positions."))) | ||
| 954 | (cond | ||
| 955 | ((null ado) | ||
| 956 | (unless (and (null (nth 2 match)) | ||
| 957 | (null (nth 3 match)) | ||
| 958 | (integer-or-marker-p (nth 4 match)) | ||
| 959 | (integer-or-marker-p (nth 5 match)) | ||
| 960 | (null (nth 6 match)) | ||
| 961 | (null (nth 7 match))) | ||
| 962 | (signal 'args-out-of-range | ||
| 963 | '("For a title candidate exactly the third match pair must be set.")))) | ||
| 964 | ((rst-Ado-is-transition ado) | ||
| 965 | (unless (and (null (nth 2 match)) | ||
| 966 | (null (nth 3 match)) | ||
| 967 | (integer-or-marker-p (nth 4 match)) | ||
| 968 | (integer-or-marker-p (nth 5 match)) | ||
| 969 | (null (nth 6 match)) | ||
| 970 | (null (nth 7 match))) | ||
| 971 | (signal 'args-out-of-range | ||
| 972 | '("For a transition exactly the third match pair must be set.")))) | ||
| 973 | ((rst-Ado-is-simple ado) | ||
| 974 | (unless (and (null (nth 2 match)) | ||
| 975 | (null (nth 3 match)) | ||
| 976 | (integer-or-marker-p (nth 4 match)) | ||
| 977 | (integer-or-marker-p (nth 5 match)) | ||
| 978 | (integer-or-marker-p (nth 6 match)) | ||
| 979 | (integer-or-marker-p (nth 7 match))) | ||
| 980 | (signal 'args-out-of-range | ||
| 981 | '("For a simple section adornment exactly the third and fourth match pair must be set.")))) | ||
| 982 | (t ;; over-and-under | ||
| 983 | (unless (and (integer-or-marker-p (nth 2 match)) | ||
| 984 | (integer-or-marker-p (nth 3 match)) | ||
| 985 | (integer-or-marker-p (nth 4 match)) | ||
| 986 | (integer-or-marker-p (nth 5 match)) | ||
| 987 | (or (null (nth 6 match)) (integer-or-marker-p (nth 6 match))) | ||
| 988 | (or (null (nth 7 match)) (integer-or-marker-p (nth 7 match)))) | ||
| 989 | (signal 'args-out-of-range | ||
| 990 | '("For a over-and-under section adornment all match pairs must be set."))))) | ||
| 991 | match) | ||
| 992 | |||
| 993 | (defun rst-Ttl--validate-indent (indent ado) | ||
| 994 | ;; testcover: ok. | ||
| 995 | "Return valid INDENT for ADO or signal error." | ||
| 996 | (if (and ado (rst-Ado-is-transition ado)) | ||
| 997 | (unless (null indent) | ||
| 998 | (signal 'args-out-of-range | ||
| 999 | '("Indent for a transition must be nil."))) | ||
| 1000 | (unless (integerp indent) | ||
| 1001 | (signal 'wrong-type-argument | ||
| 1002 | (list 'integerp indent))) | ||
| 1003 | (unless (>= indent 0) | ||
| 1004 | (signal 'args-out-of-range | ||
| 1005 | '("Indent for a section header must be non-negative.")))) | ||
| 1006 | indent) | ||
| 1007 | |||
| 1008 | (defun rst-Ttl--validate-hdr (hdr ado indent) | ||
| 1009 | ;; testcover: ok. | ||
| 1010 | "Return valid HDR in relation to ADO and INDENT or signal error." | ||
| 1011 | (unless (rst-Hdr-p hdr) | ||
| 1012 | (signal 'wrong-type-argument | ||
| 1013 | (list 'rst-Hdr-p hdr))) | ||
| 1014 | (unless (rst-Ado-equal (rst-Hdr-ado hdr) ado) | ||
| 1015 | (signal 'args-out-of-range | ||
| 1016 | '("Basic adornment and adornment in header must match."))) | ||
| 1017 | (unless (equal (rst-Hdr-indent hdr) indent) | ||
| 1018 | (signal 'args-out-of-range | ||
| 1019 | '("Basic indent and indent in header must match."))) | ||
| 1020 | hdr) | ||
| 1021 | |||
| 1022 | (defun rst-Ttl--validate-text (text ado) | ||
| 1023 | ;; testcover: ok. | ||
| 1024 | "Return valid TEXT for ADO or signal error." | ||
| 1025 | (if (and ado (rst-Ado-is-transition ado)) | ||
| 1026 | (unless (null text) | ||
| 1027 | (signal 'args-out-of-range | ||
| 1028 | '("Transitions may not have title text."))) | ||
| 1029 | (unless (stringp text) | ||
| 1030 | (signal 'wrong-type-argument | ||
| 1031 | (list 'stringp text)))) | ||
| 1032 | text) | ||
| 1033 | |||
| 1034 | (defun rst-Ttl--validate-level (level) | ||
| 1035 | ;; testcover: ok. | ||
| 1036 | "Return valid LEVEL or signal error." | ||
| 1037 | (unless (integerp level) | ||
| 1038 | (signal 'wrong-type-argument | ||
| 1039 | (list 'integerp level))) | ||
| 1040 | (unless (>= level 0) | ||
| 1041 | (signal 'args-out-of-range | ||
| 1042 | '("Level must be non-negative."))) | ||
| 1043 | level) | ||
| 1044 | |||
| 1045 | ;; Public methods | ||
| 1046 | |||
| 1047 | (defun rst-Ttl-evaluate-hdr (self) | ||
| 1048 | ;; testcover: ok. | ||
| 1049 | "Check for `ado' and `indent' in SELF forming a valid `rst-Hdr'. | ||
| 1050 | Set and return it or nil if no valid `rst-Hdr' can be formed." | ||
| 1051 | (setf (rst-Ttl-hdr self) | ||
| 1052 | (condition-case nil | ||
| 1053 | (rst-Hdr-new (rst-Ttl-ado self) (rst-Ttl-indent self)) | ||
| 1054 | (error nil)))) | ||
| 1055 | |||
| 1056 | (defun rst-Ttl-set-level (self level) | ||
| 1057 | ;; testcover: ok. | ||
| 1058 | "In SELF set and return LEVEL or nil if invalid." | ||
| 1059 | (setf (rst-Ttl-level self) | ||
| 1060 | (rst-Ttl--validate-level level))) | ||
| 1061 | |||
| 1062 | (defun rst-Ttl-get-title-beginning (self) | ||
| 1063 | ;; testcover: ok. | ||
| 1064 | "Return position of beginning of title text of SELF. | ||
| 1065 | This position should always be at the start of a line." | ||
| 1066 | (nth 4 (rst-Ttl-match self))) | ||
| 1067 | |||
| 1068 | (defun rst-Ttl-get-beginning (self) | ||
| 1069 | ;; testcover: ok. | ||
| 1070 | "Return position of beginning of whole SELF." | ||
| 1071 | (nth 0 (rst-Ttl-match self))) | ||
| 1072 | |||
| 1073 | (defun rst-Ttl-get-end (self) | ||
| 1074 | ;; testcover: ok. | ||
| 1075 | "Return position of end of whole SELF." | ||
| 1076 | (nth 1 (rst-Ttl-match self))) | ||
| 1077 | |||
| 1078 | |||
| 1079 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 1080 | ;; Class rst-Stn | ||
| 1081 | |||
| 1082 | (defstruct | ||
| 1083 | (rst-Stn | ||
| 1084 | (:constructor nil) ;; Prevent creating unchecked values. | ||
| 1085 | ;; Construct while all parameters must be valid. | ||
| 1086 | (:constructor | ||
| 1087 | rst-Stn-new | ||
| 1088 | (ttl-arg | ||
| 1089 | level-arg | ||
| 1090 | children-arg | ||
| 1091 | &aux | ||
| 1092 | (ttl (rst-Stn--validate-ttl ttl-arg)) | ||
| 1093 | (level (rst-Stn--validate-level level-arg ttl)) | ||
| 1094 | (children (rst-Stn--validate-children children-arg ttl))))) | ||
| 1095 | "Representation of a section tree node. | ||
| 1096 | |||
| 1097 | This type is immutable." | ||
| 1098 | ;; The title of the node or nil for a missing node. | ||
| 1099 | (ttl nil :read-only t) | ||
| 1100 | ;; The level of the node in the tree. Negative for the (virtual) top level | ||
| 1101 | ;; node. | ||
| 1102 | (level nil :read-only t) | ||
| 1103 | ;; The list of children of the node. | ||
| 1104 | (children nil :read-only t)) | ||
| 1105 | |||
| 1106 | ;; Private class methods | ||
| 1107 | |||
| 1108 | (defun rst-Stn--validate-ttl (ttl) | ||
| 1109 | ;; testcover: ok. | ||
| 1110 | "Return valid TTL or signal error." | ||
| 1111 | (unless (or (null ttl) (rst-Ttl-p ttl)) | ||
| 1112 | (signal 'wrong-type-argument | ||
| 1113 | (list 'null 'rst-Ttl-p ttl))) | ||
| 1114 | ttl) | ||
| 1115 | |||
| 1116 | (defun rst-Stn--validate-level (level ttl) | ||
| 1117 | ;; testcover: ok. | ||
| 1118 | "Return valid LEVEL for TTL or signal error." | ||
| 1119 | (unless (integerp level) | ||
| 1120 | (signal 'wrong-type-argument | ||
| 1121 | (list 'integerp level))) | ||
| 1122 | (when ttl | ||
| 1123 | (unless (or (not (rst-Ttl-level ttl)) | ||
| 1124 | (equal (rst-Ttl-level ttl) level)) | ||
| 1125 | (signal 'args-out-of-range | ||
| 1126 | '("A title must have correct level or none at all."))) | ||
| 1127 | (when (< level 0) | ||
| 1128 | ;; testcover: Never reached because a title may not have a negative level | ||
| 1129 | (signal 'args-out-of-range | ||
| 1130 | '("Top level node must not have a title.")))) | ||
| 1131 | level) | ||
| 1132 | |||
| 1133 | (defun rst-Stn--validate-children (children ttl) | ||
| 1134 | ;; testcover: ok. | ||
| 1135 | "Return valid CHILDREN for TTL or signal error." | ||
| 1136 | (unless (listp children) | ||
| 1137 | (signal 'wrong-type-argument | ||
| 1138 | (list 'listp children))) | ||
| 1139 | (mapcar (lambda (child) | ||
| 1140 | (unless (rst-Stn-p child) | ||
| 1141 | (signal 'wrong-type-argument | ||
| 1142 | (list 'rst-Stn-p child)))) | ||
| 1143 | children) | ||
| 1144 | (unless (or ttl children) | ||
| 1145 | (signal 'args-out-of-range | ||
| 1146 | '("A missing node must have children."))) | ||
| 1147 | children) | ||
| 1148 | |||
| 1149 | ;; Public methods | ||
| 1150 | |||
| 1151 | (defun rst-Stn-get-title-beginning (self) | ||
| 1152 | ;; testcover: ok. | ||
| 1153 | "Return the beginning of the title of SELF. | ||
| 1154 | Handles missing node properly." | ||
| 1155 | (unless (rst-Stn-p self) | ||
| 1156 | (signal 'wrong-type-argument | ||
| 1157 | (list 'rst-Stn-p self))) | ||
| 1158 | (let ((ttl (rst-Stn-ttl self))) | ||
| 1159 | (if ttl | ||
| 1160 | (rst-Ttl-get-title-beginning ttl) | ||
| 1161 | (rst-Stn-get-title-beginning (car (rst-Stn-children self)))))) | ||
| 1162 | |||
| 1163 | (defun rst-Stn-get-text (self &optional default) | ||
| 1164 | ;; testcover: ok. | ||
| 1165 | "Return title text of SELF or DEFAULT if SELF is a missing node. | ||
| 1166 | For a missing node and no DEFAULT given return a standard title text." | ||
| 1167 | (unless (rst-Stn-p self) | ||
| 1168 | (signal 'wrong-type-argument | ||
| 1169 | (list 'rst-Stn-p self))) | ||
| 1170 | (let ((ttl (rst-Stn-ttl self))) | ||
| 1171 | (cond | ||
| 1172 | (ttl | ||
| 1173 | (rst-Ttl-text ttl)) | ||
| 1174 | (default) | ||
| 1175 | ("[missing node]")))) | ||
| 1176 | |||
| 1177 | (defun rst-Stn-is-top (self) | ||
| 1178 | ;; testcover: ok. | ||
| 1179 | "Return non-nil if SELF is a top level node." | ||
| 1180 | (unless (rst-Stn-p self) | ||
| 1181 | (signal 'wrong-type-argument | ||
| 1182 | (list 'rst-Stn-p self))) | ||
| 1183 | (< (rst-Stn-level self) 0)) | ||
| 1184 | |||
| 1185 | |||
| 1186 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 606 | ;; Mode definition | 1187 | ;; Mode definition |
| 607 | 1188 | ||
| 608 | ;; testcover: ok. | ||
| 609 | (defun rst-define-key (keymap key def &rest deprecated) | 1189 | (defun rst-define-key (keymap key def &rest deprecated) |
| 1190 | ;; testcover: ok. | ||
| 610 | "Bind like `define-key' but add deprecated key definitions. | 1191 | "Bind like `define-key' but add deprecated key definitions. |
| 611 | KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key | 1192 | KEYMAP, KEY, and DEF are as in `define-key'. DEPRECATED key |
| 612 | definitions should be in vector notation. These are defined | 1193 | definitions should be in vector notation. These are defined |
| @@ -618,7 +1199,7 @@ as well but give an additional message." | |||
| 618 | (if (string-match "^rst-\\(.*\\)$" command-name) | 1199 | (if (string-match "^rst-\\(.*\\)$" command-name) |
| 619 | (concat "rst-deprecated-" | 1200 | (concat "rst-deprecated-" |
| 620 | (match-string 1 command-name)) | 1201 | (match-string 1 command-name)) |
| 621 | (error "not an RST command: %s" command-name))) | 1202 | (error "Not an RST command: %s" command-name))) |
| 622 | (forwarder-function (intern forwarder-function-name))) | 1203 | (forwarder-function (intern forwarder-function-name))) |
| 623 | (unless (fboundp forwarder-function) | 1204 | (unless (fboundp forwarder-function) |
| 624 | (defalias forwarder-function | 1205 | (defalias forwarder-function |
| @@ -633,6 +1214,7 @@ as well but give an additional message." | |||
| 633 | def def))) | 1214 | def def))) |
| 634 | (dolist (dep-key deprecated) | 1215 | (dolist (dep-key deprecated) |
| 635 | (define-key keymap dep-key forwarder-function))))) | 1216 | (define-key keymap dep-key forwarder-function))))) |
| 1217 | |||
| 636 | ;; Key bindings. | 1218 | ;; Key bindings. |
| 637 | (defvar rst-mode-map | 1219 | (defvar rst-mode-map |
| 638 | (let ((map (make-sparse-keymap))) | 1220 | (let ((map (make-sparse-keymap))) |
| @@ -654,9 +1236,9 @@ as well but give an additional message." | |||
| 654 | (rst-define-key map [?\C-c ?\C-a ?\C-a] 'rst-adjust) | 1236 | (rst-define-key map [?\C-c ?\C-a ?\C-a] 'rst-adjust) |
| 655 | ;; Display the hierarchy of adornments implied by the current document | 1237 | ;; Display the hierarchy of adornments implied by the current document |
| 656 | ;; contents. | 1238 | ;; contents. |
| 657 | (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-adornments-hierarchy) | 1239 | (rst-define-key map [?\C-c ?\C-a ?\C-d] 'rst-display-hdr-hierarchy) |
| 658 | ;; Homogenize the adornments in the document. | 1240 | ;; Homogenize the adornments in the document. |
| 659 | (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-adornments | 1241 | (rst-define-key map [?\C-c ?\C-a ?\C-s] 'rst-straighten-sections |
| 660 | [?\C-c ?\C-s]) | 1242 | [?\C-c ?\C-s]) |
| 661 | 1243 | ||
| 662 | ;; | 1244 | ;; |
| @@ -818,71 +1400,62 @@ highlighting. | |||
| 818 | :group 'rst | 1400 | :group 'rst |
| 819 | 1401 | ||
| 820 | ;; Paragraph recognition. | 1402 | ;; Paragraph recognition. |
| 821 | (set (make-local-variable 'paragraph-separate) | 1403 | (setq-local paragraph-separate |
| 822 | (rst-re '(:alt | 1404 | (rst-re '(:alt |
| 823 | "\f" | 1405 | "\f" |
| 824 | lin-end))) | 1406 | lin-end))) |
| 825 | (set (make-local-variable 'paragraph-start) | 1407 | (setq-local paragraph-start |
| 826 | (rst-re '(:alt | 1408 | (rst-re '(:alt |
| 827 | "\f" | 1409 | "\f" |
| 828 | lin-end | 1410 | lin-end |
| 829 | (:seq hws-tag par-tag- bli-sfx)))) | 1411 | (:seq hws-tag par-tag- bli-sfx)))) |
| 830 | 1412 | ||
| 831 | ;; Indenting and filling. | 1413 | ;; Indenting and filling. |
| 832 | (set (make-local-variable 'indent-line-function) 'rst-indent-line) | 1414 | (setq-local indent-line-function 'rst-indent-line) |
| 833 | (set (make-local-variable 'adaptive-fill-mode) t) | 1415 | (setq-local adaptive-fill-mode t) |
| 834 | (set (make-local-variable 'adaptive-fill-regexp) | 1416 | (setq-local adaptive-fill-regexp (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) |
| 835 | (rst-re 'hws-tag 'par-tag- "?" 'hws-tag)) | 1417 | (setq-local adaptive-fill-function 'rst-adaptive-fill) |
| 836 | (set (make-local-variable 'adaptive-fill-function) 'rst-adaptive-fill) | 1418 | (setq-local fill-paragraph-handle-comment nil) |
| 837 | (set (make-local-variable 'fill-paragraph-handle-comment) nil) | ||
| 838 | 1419 | ||
| 839 | ;; Comments. | 1420 | ;; Comments. |
| 840 | (set (make-local-variable 'comment-start) ".. ") | 1421 | (setq-local comment-start ".. ") |
| 841 | (set (make-local-variable 'comment-start-skip) | 1422 | (setq-local comment-start-skip (rst-re 'lin-beg 'exm-tag 'bli-sfx)) |
| 842 | (rst-re 'lin-beg 'exm-tag 'bli-sfx)) | 1423 | (setq-local comment-continue " ") |
| 843 | (set (make-local-variable 'comment-continue) " ") | 1424 | (setq-local comment-multi-line t) |
| 844 | (set (make-local-variable 'comment-multi-line) t) | 1425 | (setq-local comment-use-syntax nil) |
| 845 | (set (make-local-variable 'comment-use-syntax) nil) | ||
| 846 | ;; reStructuredText has not really a comment ender but nil is not really a | 1426 | ;; reStructuredText has not really a comment ender but nil is not really a |
| 847 | ;; permissible value. | 1427 | ;; permissible value. |
| 848 | (set (make-local-variable 'comment-end) "") | 1428 | (setq-local comment-end "") |
| 849 | (set (make-local-variable 'comment-end-skip) nil) | 1429 | (setq-local comment-end-skip nil) |
| 850 | 1430 | ||
| 851 | ;; Commenting in reStructuredText is very special so use our own set of | 1431 | ;; Commenting in reStructuredText is very special so use our own set of |
| 852 | ;; functions. | 1432 | ;; functions. |
| 853 | (set (make-local-variable 'comment-line-break-function) | 1433 | (setq-local comment-line-break-function 'rst-comment-line-break) |
| 854 | 'rst-comment-line-break) | 1434 | (setq-local comment-indent-function 'rst-comment-indent) |
| 855 | (set (make-local-variable 'comment-indent-function) | 1435 | (setq-local comment-insert-comment-function 'rst-comment-insert-comment) |
| 856 | 'rst-comment-indent) | 1436 | (setq-local comment-region-function 'rst-comment-region) |
| 857 | (set (make-local-variable 'comment-insert-comment-function) | 1437 | (setq-local uncomment-region-function 'rst-uncomment-region) |
| 858 | 'rst-comment-insert-comment) | 1438 | |
| 859 | (set (make-local-variable 'comment-region-function) | 1439 | (setq-local electric-pair-pairs '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) |
| 860 | 'rst-comment-region) | ||
| 861 | (set (make-local-variable 'uncomment-region-function) | ||
| 862 | 'rst-uncomment-region) | ||
| 863 | |||
| 864 | (set (make-local-variable 'electric-pair-pairs) | ||
| 865 | '((?\" . ?\") (?\* . ?\*) (?\` . ?\`))) | ||
| 866 | 1440 | ||
| 867 | ;; Imenu and which function. | 1441 | ;; Imenu and which function. |
| 868 | ;; FIXME: Check documentation of `which-function' for alternative ways to | 1442 | ;; FIXME: Check documentation of `which-function' for alternative ways to |
| 869 | ;; determine the current function name. | 1443 | ;; determine the current function name. |
| 870 | (set (make-local-variable 'imenu-create-index-function) | 1444 | (setq-local imenu-create-index-function 'rst-imenu-create-index) |
| 871 | 'rst-imenu-create-index) | ||
| 872 | 1445 | ||
| 873 | ;; Font lock. | 1446 | ;; Font lock. |
| 874 | (set (make-local-variable 'font-lock-defaults) | 1447 | (setq-local font-lock-defaults |
| 875 | '(rst-font-lock-keywords | 1448 | '(rst-font-lock-keywords |
| 876 | t nil nil nil | 1449 | t nil nil nil |
| 877 | (font-lock-multiline . t) | 1450 | (font-lock-multiline . t) |
| 878 | (font-lock-mark-block-function . mark-paragraph))) | 1451 | (font-lock-mark-block-function . mark-paragraph))) |
| 879 | (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t) | 1452 | (add-hook 'font-lock-extend-region-functions 'rst-font-lock-extend-region t) |
| 880 | 1453 | ||
| 881 | ;; Text after a changed line may need new fontification. | 1454 | ;; Text after a changed line may need new fontification. |
| 882 | (set (make-local-variable 'jit-lock-contextually) t) | 1455 | (setq-local jit-lock-contextually t) |
| 883 | 1456 | ||
| 884 | ;; Indentation is not deterministic. | 1457 | ;; Indentation is not deterministic. |
| 885 | (setq electric-indent-inhibit t)) | 1458 | (setq-local electric-indent-inhibit t)) |
| 886 | 1459 | ||
| 887 | ;;;###autoload | 1460 | ;;;###autoload |
| 888 | (define-minor-mode rst-minor-mode | 1461 | (define-minor-mode rst-minor-mode |
| @@ -908,38 +1481,14 @@ for modes derived from Text mode, like Mail mode." | |||
| 908 | 1481 | ||
| 909 | 1482 | ||
| 910 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1483 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 911 | ;; Section Adornment Adjustment | 1484 | ;; Section adornment adjustment |
| 912 | ;; ============================ | 1485 | |
| 913 | ;; | ||
| 914 | ;; The following functions implement a smart automatic title sectioning feature. | 1486 | ;; The following functions implement a smart automatic title sectioning feature. |
| 915 | ;; The idea is that with the cursor sitting on a section title, we try to get as | 1487 | ;; The idea is that with the cursor sitting on a section title, we try to get as |
| 916 | ;; much information from context and try to do the best thing automatically. | 1488 | ;; much information from context and try to do the best thing automatically. |
| 917 | ;; This function can be invoked many times and/or with prefix argument to rotate | 1489 | ;; This function can be invoked many times and/or with prefix argument to rotate |
| 918 | ;; between the various sectioning adornments. | 1490 | ;; between the various sectioning adornments. |
| 919 | ;; | 1491 | ;; |
| 920 | ;; Definitions: the two forms of sectioning define semantically separate section | ||
| 921 | ;; levels. A sectioning ADORNMENT consists in: | ||
| 922 | ;; | ||
| 923 | ;; - a CHARACTER | ||
| 924 | ;; | ||
| 925 | ;; - a STYLE which can be either of 'simple' or 'over-and-under'. | ||
| 926 | ;; | ||
| 927 | ;; - an INDENT (meaningful for the over-and-under style only) which determines | ||
| 928 | ;; how many characters and over-and-under style is hanging outside of the | ||
| 929 | ;; title at the beginning and ending. | ||
| 930 | ;; | ||
| 931 | ;; Here are two examples of adornments (| represents the window border, column | ||
| 932 | ;; 0): | ||
| 933 | ;; | ||
| 934 | ;; | | ||
| 935 | ;; 1. char: '-' e |Some Title | ||
| 936 | ;; style: simple |---------- | ||
| 937 | ;; | | ||
| 938 | ;; 2. char: '=' |============== | ||
| 939 | ;; style: over-and-under | Some Title | ||
| 940 | ;; indent: 2 |============== | ||
| 941 | ;; | | ||
| 942 | ;; | ||
| 943 | ;; Some notes: | 1492 | ;; Some notes: |
| 944 | ;; | 1493 | ;; |
| 945 | ;; - The underlining character that is used depends on context. The file is | 1494 | ;; - The underlining character that is used depends on context. The file is |
| @@ -948,7 +1497,7 @@ for modes derived from Text mode, like Mail mode." | |||
| 948 | ;; rotated among the existing section adornments. | 1497 | ;; rotated among the existing section adornments. |
| 949 | ;; | 1498 | ;; |
| 950 | ;; Note that when rotating the characters, if we come to the end of the | 1499 | ;; Note that when rotating the characters, if we come to the end of the |
| 951 | ;; hierarchy of adornments, the variable rst-preferred-adornments is | 1500 | ;; hierarchy of adornments, the variable `rst-preferred-adornments' is |
| 952 | ;; consulted to propose a new underline adornment, and if continued, we cycle | 1501 | ;; consulted to propose a new underline adornment, and if continued, we cycle |
| 953 | ;; the adornments all over again. Set this variable to nil if you want to | 1502 | ;; the adornments all over again. Set this variable to nil if you want to |
| 954 | ;; limit the underlining character propositions to the existing adornments in | 1503 | ;; limit the underlining character propositions to the existing adornments in |
| @@ -986,6 +1535,8 @@ for modes derived from Text mode, like Mail mode." | |||
| 986 | 1535 | ||
| 987 | (define-obsolete-variable-alias | 1536 | (define-obsolete-variable-alias |
| 988 | 'rst-preferred-decorations 'rst-preferred-adornments "rst 1.0.0") | 1537 | 'rst-preferred-decorations 'rst-preferred-adornments "rst 1.0.0") |
| 1538 | ;; FIXME: Default must match suggestion in | ||
| 1539 | ;; http://sphinx-doc.org/rest.html#sections for Python documentation. | ||
| 989 | (defcustom rst-preferred-adornments '((?= over-and-under 1) | 1540 | (defcustom rst-preferred-adornments '((?= over-and-under 1) |
| 990 | (?= simple 0) | 1541 | (?= simple 0) |
| 991 | (?- simple 0) | 1542 | (?- simple 0) |
| @@ -995,13 +1546,10 @@ for modes derived from Text mode, like Mail mode." | |||
| 995 | (?# simple 0) | 1546 | (?# simple 0) |
| 996 | (?@ simple 0)) | 1547 | (?@ simple 0)) |
| 997 | "Preferred hierarchy of section title adornments. | 1548 | "Preferred hierarchy of section title adornments. |
| 998 | |||
| 999 | A list consisting of lists of the form (CHARACTER STYLE INDENT). | 1549 | A list consisting of lists of the form (CHARACTER STYLE INDENT). |
| 1000 | CHARACTER is the character used. STYLE is one of the symbols | 1550 | CHARACTER is the character used. STYLE is one of the symbols |
| 1001 | `over-and-under' or `simple'. INDENT is an integer giving the | 1551 | `over-and-under' or `simple'. INDENT is an integer giving the |
| 1002 | wanted indentation for STYLE `over-and-under'. CHARACTER and | 1552 | wanted indentation for STYLE `over-and-under'. |
| 1003 | STYLE are always used when a section adornment is described. | ||
| 1004 | In other places, t instead of a list stands for a transition. | ||
| 1005 | 1553 | ||
| 1006 | This sequence is consulted to offer a new adornment suggestion | 1554 | This sequence is consulted to offer a new adornment suggestion |
| 1007 | when we rotate the underlines at the end of the existing | 1555 | when we rotate the underlines at the end of the existing |
| @@ -1025,156 +1573,111 @@ file." | |||
| 1025 | :value 0)))) | 1573 | :value 0)))) |
| 1026 | (rst-testcover-defcustom) | 1574 | (rst-testcover-defcustom) |
| 1027 | 1575 | ||
| 1576 | ;; FIXME: Rename this to `rst-over-and-under-default-indent' and set default to | ||
| 1577 | ;; 0 because the effect of 1 is probably surprising in the few cases | ||
| 1578 | ;; where this is used. | ||
| 1579 | ;; FIXME: A matching adornment style can be looked for in | ||
| 1580 | ;; `rst-preferred-adornments' and its indentation used before using this | ||
| 1581 | ;; variable. | ||
| 1028 | (defcustom rst-default-indent 1 | 1582 | (defcustom rst-default-indent 1 |
| 1029 | "Number of characters to indent the section title. | 1583 | "Number of characters to indent the section title. |
| 1030 | 1584 | This is only used while toggling adornment styles when switching | |
| 1031 | This is used for when toggling adornment styles, when switching | ||
| 1032 | from a simple adornment style to a over-and-under adornment | 1585 | from a simple adornment style to a over-and-under adornment |
| 1033 | style." | 1586 | style. In addition this is used in cases where the adornments |
| 1587 | found in the buffer are to be used but the indentation for | ||
| 1588 | over-and-under adornments is inconsistent across the buffer." | ||
| 1034 | :group 'rst-adjust | 1589 | :group 'rst-adjust |
| 1035 | :type '(integer)) | 1590 | :type '(integer)) |
| 1036 | (rst-testcover-defcustom) | 1591 | (rst-testcover-defcustom) |
| 1037 | 1592 | ||
| 1038 | (defun rst-compare-adornments (ado1 ado2) | 1593 | (defun rst-new-preferred-hdr (seen prev) |
| 1039 | "Compare adornments. | 1594 | ;; testcover: ok. |
| 1040 | Return true if both ADO1 and ADO2 adornments are equal, | 1595 | "Return a new, preferred `rst-Hdr' different from all in SEEN. |
| 1041 | according to restructured text semantics (only the character | 1596 | PREV is the previous `rst-Hdr' in the buffer. If given the |
| 1042 | and the style are compared, the indentation does not matter)." | 1597 | search starts after this entry. Return nil if no new preferred |
| 1043 | (and (eq (car ado1) (car ado2)) | 1598 | `rst-Hdr' can be found." |
| 1044 | (eq (cadr ado1) (cadr ado2)))) | 1599 | ;; All preferred adornments are candidates. |
| 1045 | 1600 | (let ((candidates | |
| 1046 | 1601 | (append | |
| 1047 | (defun rst-get-adornment-match (hier ado) | 1602 | (if prev |
| 1048 | "Return the index (level) in hierarchy HIER of adornment ADO. | 1603 | ;; Start searching after the level of the previous adornment. |
| 1049 | This basically just searches for the item using the appropriate | 1604 | (cdr (rst-Hdr-member-ado prev (rst-Hdr-preferred-adornments)))) |
| 1050 | comparison and returns the index. Return nil if the item is | 1605 | (rst-Hdr-preferred-adornments)))) |
| 1051 | not found." | 1606 | (car |
| 1052 | (let ((cur hier)) | 1607 | (rst-member-if (lambda (cand) |
| 1053 | (while (and cur (not (rst-compare-adornments (car cur) ado))) | 1608 | (not (rst-Hdr-member-ado cand seen))) |
| 1054 | (setq cur (cdr cur))) | 1609 | candidates)))) |
| 1055 | cur)) | ||
| 1056 | |||
| 1057 | ;; testcover: FIXME: Test with `rst-preferred-adornments' == nil. Add test | ||
| 1058 | ;; `rst-adjust-no-preference'. | ||
| 1059 | (defun rst-suggest-new-adornment (allados &optional prev) | ||
| 1060 | "Suggest a new, different adornment from all that have been seen. | ||
| 1061 | |||
| 1062 | ALLADOS is the set of all adornments, including the line numbers. | ||
| 1063 | PREV is the optional previous adornment, in order to suggest a | ||
| 1064 | better match." | ||
| 1065 | |||
| 1066 | ;; For all the preferred adornments... | ||
| 1067 | (let* ( | ||
| 1068 | ;; If 'prev' is given, reorder the list to start searching after the | ||
| 1069 | ;; match. | ||
| 1070 | (fplist | ||
| 1071 | (cdr (rst-get-adornment-match rst-preferred-adornments prev))) | ||
| 1072 | |||
| 1073 | ;; List of candidates to search. | ||
| 1074 | (curpotential (append fplist rst-preferred-adornments))) | ||
| 1075 | (while | ||
| 1076 | ;; For all the adornments... | ||
| 1077 | (let ((cur allados) | ||
| 1078 | found) | ||
| 1079 | (while (and cur (not found)) | ||
| 1080 | (if (rst-compare-adornments (car cur) (car curpotential)) | ||
| 1081 | ;; Found it! | ||
| 1082 | (setq found (car curpotential)) | ||
| 1083 | (setq cur (cdr cur)))) | ||
| 1084 | found) | ||
| 1085 | |||
| 1086 | (setq curpotential (cdr curpotential))) | ||
| 1087 | |||
| 1088 | (copy-sequence (car curpotential)))) | ||
| 1089 | 1610 | ||
| 1090 | (defun rst-delete-entire-line () | 1611 | (defun rst-delete-entire-line () |
| 1091 | "Delete the entire current line without using the `kill-ring'." | 1612 | "Delete the entire current line without using the `kill-ring'." |
| 1092 | (delete-region (line-beginning-position) | 1613 | (delete-region (line-beginning-position) |
| 1093 | (line-beginning-position 2))) | 1614 | (line-beginning-position 2))) |
| 1094 | 1615 | ||
| 1095 | (defun rst-update-section (char style &optional indent) | 1616 | (defun rst-update-section (hdr) |
| 1096 | "Unconditionally update the style of a section adornment. | 1617 | "Unconditionally update the style of the section header at point to HDR. |
| 1097 | |||
| 1098 | Do this using the given character CHAR, with STYLE `simple' | ||
| 1099 | or `over-and-under', and with indent INDENT. If the STYLE | ||
| 1100 | is `simple', whitespace before the title is removed (indent | ||
| 1101 | is always assumed to be 0). | ||
| 1102 | |||
| 1103 | If there are existing overline and/or underline from the | 1618 | If there are existing overline and/or underline from the |
| 1104 | existing adornment, they are removed before adding the | 1619 | existing adornment, they are removed before adding the |
| 1105 | requested adornment." | 1620 | requested adornment." |
| 1106 | (end-of-line) | 1621 | (end-of-line) |
| 1107 | (let ((marker (point-marker)) | 1622 | (let ((indent (or (rst-Hdr-indent hdr) 0)) |
| 1108 | len) | 1623 | (marker (point-marker)) |
| 1624 | len) | ||
| 1109 | 1625 | ||
| 1110 | ;; Fixup whitespace at the beginning and end of the line. | 1626 | ;; Fixup whitespace at the beginning and end of the line. |
| 1111 | (if (or (null indent) (eq style 'simple)) ;; testcover: ok. | 1627 | (beginning-of-line) |
| 1112 | (setq indent 0)) | 1628 | (delete-horizontal-space) |
| 1113 | (beginning-of-line) | 1629 | (insert (make-string indent ? )) |
| 1114 | (delete-horizontal-space) | ||
| 1115 | (insert (make-string indent ? )) | ||
| 1116 | 1630 | ||
| 1117 | (end-of-line) | 1631 | (end-of-line) |
| 1118 | (delete-horizontal-space) | 1632 | (delete-horizontal-space) |
| 1119 | 1633 | ||
| 1120 | ;; Set the current column, we're at the end of the title line. | 1634 | ;; Set the current column, we're at the end of the title line. |
| 1121 | (setq len (+ (current-column) indent)) | 1635 | (setq len (+ (current-column) indent)) |
| 1122 | 1636 | ||
| 1123 | ;; Remove previous line if it is an adornment. | 1637 | ;; Remove previous line if it is an adornment. |
| 1124 | (save-excursion | 1638 | (save-excursion |
| 1125 | (forward-line -1) ;; testcover: FIXME: Doesn't work when in first line | 1639 | (forward-line -1) ;; FIXME testcover: Doesn't work when in first line of |
| 1126 | ;; of buffer. | 1640 | ;; buffer. |
| 1127 | (if (and (looking-at (rst-re 'ado-beg-2-1)) | 1641 | (if (and (looking-at (rst-re 'ado-beg-2-1)) |
| 1128 | ;; Avoid removing the underline of a title right above us. | 1642 | ;; Avoid removing the underline of a title right above us. |
| 1129 | (save-excursion (forward-line -1) | 1643 | (save-excursion (forward-line -1) |
| 1130 | (not (looking-at (rst-re 'ttl-beg))))) | 1644 | (not (looking-at (rst-re 'ttl-beg-1))))) |
| 1131 | (rst-delete-entire-line))) | 1645 | (rst-delete-entire-line))) |
| 1132 | 1646 | ||
| 1133 | ;; Remove following line if it is an adornment. | 1647 | ;; Remove following line if it is an adornment. |
| 1648 | (save-excursion | ||
| 1649 | (forward-line +1) ;; FIXME testcover: Doesn't work when in last line | ||
| 1650 | ;; of buffer. | ||
| 1651 | (if (looking-at (rst-re 'ado-beg-2-1)) | ||
| 1652 | (rst-delete-entire-line)) | ||
| 1653 | ;; Add a newline if we're at the end of the buffer unless it is the final | ||
| 1654 | ;; empty line, for the subsequent inserting of the underline. | ||
| 1655 | (if (and (= (point) (buffer-end 1)) (not (bolp))) | ||
| 1656 | (newline 1))) | ||
| 1657 | |||
| 1658 | ;; Insert overline. | ||
| 1659 | (when (rst-Hdr-is-over-and-under hdr) | ||
| 1134 | (save-excursion | 1660 | (save-excursion |
| 1135 | (forward-line +1) ;; testcover: FIXME: Doesn't work when in last line | 1661 | (beginning-of-line) |
| 1136 | ;; of buffer. | 1662 | (open-line 1) |
| 1137 | (if (looking-at (rst-re 'ado-beg-2-1)) | 1663 | (insert (make-string len (rst-Hdr-get-char hdr))))) |
| 1138 | (rst-delete-entire-line)) | 1664 | |
| 1139 | ;; Add a newline if we're at the end of the buffer, for the subsequence | 1665 | ;; Insert underline. |
| 1140 | ;; inserting of the underline. | 1666 | (1value ;; Line has been inserted above. |
| 1141 | (if (= (point) (buffer-end 1)) | 1667 | (forward-line +1)) |
| 1142 | (newline 1))) | 1668 | (open-line 1) |
| 1143 | 1669 | (insert (make-string len (rst-Hdr-get-char hdr))) | |
| 1144 | ;; Insert overline. | 1670 | |
| 1145 | (if (eq style 'over-and-under) | 1671 | (1value ;; Line has been inserted above. |
| 1146 | (save-excursion | 1672 | (forward-line +1)) |
| 1147 | (beginning-of-line) | 1673 | (goto-char marker))) |
| 1148 | (open-line 1) | ||
| 1149 | (insert (make-string len char)))) | ||
| 1150 | |||
| 1151 | ;; Insert underline. | ||
| 1152 | (1value ;; Line has been inserted above. | ||
| 1153 | (forward-line +1)) | ||
| 1154 | (open-line 1) | ||
| 1155 | (insert (make-string len char)) | ||
| 1156 | |||
| 1157 | (1value ;; Line has been inserted above. | ||
| 1158 | (forward-line +1)) | ||
| 1159 | (goto-char marker))) | ||
| 1160 | 1674 | ||
| 1161 | (defun rst-classify-adornment (adornment end) | 1675 | (defun rst-classify-adornment (adornment end) |
| 1162 | "Classify adornment for section titles and transitions. | 1676 | "Classify adornment string for section titles and transitions. |
| 1163 | ADORNMENT is the complete adornment string as found in the buffer | 1677 | ADORNMENT is the complete adornment string as found in the buffer |
| 1164 | with optional trailing whitespace. END is the point after the | 1678 | with optional trailing whitespace. END is the point after the |
| 1165 | last character of ADORNMENT. | 1679 | last character of ADORNMENT. Return a `rst-Ttl' or nil if no |
| 1166 | 1680 | syntactically valid adornment is found." | |
| 1167 | Return a list. The first entry is t for a transition or a | ||
| 1168 | cons (CHARACTER . STYLE). Check `rst-preferred-adornments' for | ||
| 1169 | the meaning of CHARACTER and STYLE. | ||
| 1170 | |||
| 1171 | The remaining list forms four match groups as returned by | ||
| 1172 | `match-data'. Match group 0 matches the whole construct. Match | ||
| 1173 | group 1 matches the overline adornment if present. Match group 2 | ||
| 1174 | matches the section title text or the transition. Match group 3 | ||
| 1175 | matches the underline adornment. | ||
| 1176 | |||
| 1177 | Return nil if no syntactically valid adornment is found." | ||
| 1178 | (save-excursion | 1681 | (save-excursion |
| 1179 | (save-match-data | 1682 | (save-match-data |
| 1180 | (when (string-match (rst-re 'ado-beg-2-1) adornment) | 1683 | (when (string-match (rst-re 'ado-beg-2-1) adornment) |
| @@ -1189,31 +1692,35 @@ Return nil if no syntactically valid adornment is found." | |||
| 1189 | (nxt-emp ; Next line nonexistent or empty | 1692 | (nxt-emp ; Next line nonexistent or empty |
| 1190 | (save-excursion | 1693 | (save-excursion |
| 1191 | (or (not (zerop (forward-line 1))) | 1694 | (or (not (zerop (forward-line 1))) |
| 1192 | ;; testcover: FIXME: Add test classifying at the end of | 1695 | ;; FIXME testcover: Add test classifying at the end of |
| 1193 | ;; buffer. | 1696 | ;; buffer. |
| 1194 | (looking-at (rst-re 'lin-end))))) | 1697 | (looking-at (rst-re 'lin-end))))) |
| 1195 | (prv-emp ; Previous line nonexistent or empty | 1698 | (prv-emp ; Previous line nonexistent or empty |
| 1196 | (save-excursion | 1699 | (save-excursion |
| 1197 | (or (not (zerop (forward-line -1))) | 1700 | (or (not (zerop (forward-line -1))) |
| 1198 | (looking-at (rst-re 'lin-end))))) | 1701 | (looking-at (rst-re 'lin-end))))) |
| 1702 | txt-blw | ||
| 1199 | (ttl-blw ; Title found below starting here. | 1703 | (ttl-blw ; Title found below starting here. |
| 1200 | (save-excursion | 1704 | (save-excursion |
| 1201 | (and | 1705 | (and |
| 1202 | (zerop (forward-line 1)) ;; testcover: FIXME: Add test | 1706 | (zerop (forward-line 1)) ;; FIXME testcover: Add test |
| 1203 | ;; classifying at the end of | 1707 | ;; classifying at the end of |
| 1204 | ;; buffer. | 1708 | ;; buffer. |
| 1205 | (looking-at (rst-re 'ttl-beg)) | 1709 | (looking-at (rst-re 'ttl-beg-1)) |
| 1710 | (setq txt-blw (match-string-no-properties 1)) | ||
| 1206 | (point)))) | 1711 | (point)))) |
| 1712 | txt-abv | ||
| 1207 | (ttl-abv ; Title found above starting here. | 1713 | (ttl-abv ; Title found above starting here. |
| 1208 | (save-excursion | 1714 | (save-excursion |
| 1209 | (and | 1715 | (and |
| 1210 | (zerop (forward-line -1)) | 1716 | (zerop (forward-line -1)) |
| 1211 | (looking-at (rst-re 'ttl-beg)) | 1717 | (looking-at (rst-re 'ttl-beg-1)) |
| 1718 | (setq txt-abv (match-string-no-properties 1)) | ||
| 1212 | (point)))) | 1719 | (point)))) |
| 1213 | (und-fnd ; Matching underline found starting here. | 1720 | (und-fnd ; Matching underline found starting here. |
| 1214 | (save-excursion | 1721 | (save-excursion |
| 1215 | (and ttl-blw | 1722 | (and ttl-blw |
| 1216 | (zerop (forward-line 2)) ;; testcover: FIXME: Add test | 1723 | (zerop (forward-line 2)) ;; FIXME testcover: Add test |
| 1217 | ;; classifying at the end of | 1724 | ;; classifying at the end of |
| 1218 | ;; buffer. | 1725 | ;; buffer. |
| 1219 | (looking-at (rst-re ado-re 'lin-end)) | 1726 | (looking-at (rst-re ado-re 'lin-end)) |
| @@ -1224,16 +1731,16 @@ Return nil if no syntactically valid adornment is found." | |||
| 1224 | (zerop (forward-line -2)) | 1731 | (zerop (forward-line -2)) |
| 1225 | (looking-at (rst-re ado-re 'lin-end)) | 1732 | (looking-at (rst-re ado-re 'lin-end)) |
| 1226 | (point)))) | 1733 | (point)))) |
| 1227 | key beg-ovr end-ovr beg-txt end-txt beg-und end-und) | 1734 | ado ind txt beg-ovr end-ovr beg-txt end-txt beg-und end-und) |
| 1228 | (cond | 1735 | (cond |
| 1229 | ((and nxt-emp prv-emp) | 1736 | ((and nxt-emp prv-emp) |
| 1230 | ;; A transition. | 1737 | ;; A transition. |
| 1231 | (setq key t | 1738 | (setq ado (rst-Ado-new-transition) |
| 1232 | beg-txt beg-pnt | 1739 | beg-txt beg-pnt |
| 1233 | end-txt end-pnt)) | 1740 | end-txt end-pnt)) |
| 1234 | ((or und-fnd ovr-fnd) | 1741 | ((or und-fnd ovr-fnd) |
| 1235 | ;; An overline with an underline. | 1742 | ;; An overline with an underline. |
| 1236 | (setq key (cons ado-ch 'over-and-under)) | 1743 | (setq ado (rst-Ado-new-over-and-under ado-ch)) |
| 1237 | (let (;; Prefer overline match over underline match. | 1744 | (let (;; Prefer overline match over underline match. |
| 1238 | (und-pnt (if ovr-fnd beg-pnt und-fnd)) | 1745 | (und-pnt (if ovr-fnd beg-pnt und-fnd)) |
| 1239 | (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt)) | 1746 | (ovr-pnt (if ovr-fnd ovr-fnd beg-pnt)) |
| @@ -1243,41 +1750,40 @@ Return nil if no syntactically valid adornment is found." | |||
| 1243 | end-ovr (line-end-position)) | 1750 | end-ovr (line-end-position)) |
| 1244 | (goto-char txt-pnt) | 1751 | (goto-char txt-pnt) |
| 1245 | (setq beg-txt (point) | 1752 | (setq beg-txt (point) |
| 1246 | end-txt (line-end-position)) | 1753 | end-txt (line-end-position) |
| 1754 | ind (current-indentation) | ||
| 1755 | txt (if ovr-fnd txt-abv txt-blw)) | ||
| 1247 | (goto-char und-pnt) | 1756 | (goto-char und-pnt) |
| 1248 | (setq beg-und (point) | 1757 | (setq beg-und (point) |
| 1249 | end-und (line-end-position)))) | 1758 | end-und (line-end-position)))) |
| 1250 | (ttl-abv | 1759 | (ttl-abv |
| 1251 | ;; An underline. | 1760 | ;; An underline. |
| 1252 | (setq key (cons ado-ch 'simple) | 1761 | (setq ado (rst-Ado-new-simple ado-ch) |
| 1253 | beg-und beg-pnt | 1762 | beg-und beg-pnt |
| 1254 | end-und end-pnt) | 1763 | end-und end-pnt) |
| 1255 | (goto-char ttl-abv) | 1764 | (goto-char ttl-abv) |
| 1256 | (setq beg-txt (point) | 1765 | (setq beg-txt (point) |
| 1257 | end-txt (line-end-position))) | 1766 | end-txt (line-end-position) |
| 1767 | ind (current-indentation) | ||
| 1768 | txt txt-abv)) | ||
| 1258 | (t | 1769 | (t |
| 1259 | ;; Invalid adornment. | 1770 | ;; Invalid adornment. |
| 1260 | (setq key nil))) | 1771 | (setq ado nil))) |
| 1261 | (if key | 1772 | (if ado |
| 1262 | (list key | 1773 | (rst-Ttl-new ado |
| 1263 | (or beg-ovr beg-txt) | 1774 | (list |
| 1264 | (or end-und end-txt) | 1775 | (or beg-ovr beg-txt) |
| 1265 | beg-ovr end-ovr beg-txt end-txt beg-und end-und))))))) | 1776 | (or end-und end-txt) |
| 1266 | 1777 | beg-ovr end-ovr beg-txt end-txt beg-und end-und) | |
| 1267 | (defun rst-find-title-line () | 1778 | ind txt))))))) |
| 1779 | |||
| 1780 | (defun rst-ttl-at-point () | ||
| 1268 | "Find a section title line around point and return its characteristics. | 1781 | "Find a section title line around point and return its characteristics. |
| 1269 | If the point is on an adornment line find the respective title | 1782 | If the point is on an adornment line find the respective title |
| 1270 | line. If the point is on an empty line check previous or next | 1783 | line. If the point is on an empty line check previous or next |
| 1271 | line whether it is a suitable title line and use it if so. If | 1784 | line whether it is a suitable title line and use it if so. If |
| 1272 | point is on a suitable title line use it. | 1785 | point is on a suitable title line use it. Return a `rst-Ttl' for |
| 1273 | 1786 | a section header or nil if no title line is found." | |
| 1274 | If no title line is found return nil. | ||
| 1275 | |||
| 1276 | Otherwise return as `rst-classify-adornment' does. However, if | ||
| 1277 | the title line has no syntactically valid adornment, STYLE is nil | ||
| 1278 | in the first element. If there is no adornment around the title, | ||
| 1279 | CHARACTER is also nil and match groups for overline and underline | ||
| 1280 | are nil." | ||
| 1281 | (save-excursion | 1787 | (save-excursion |
| 1282 | (1value ;; No lines may be left to move. | 1788 | (1value ;; No lines may be left to move. |
| 1283 | (forward-line 0)) | 1789 | (forward-line 0)) |
| @@ -1285,225 +1791,258 @@ are nil." | |||
| 1285 | (orig-end (line-end-position))) | 1791 | (orig-end (line-end-position))) |
| 1286 | (cond | 1792 | (cond |
| 1287 | ((looking-at (rst-re 'ado-beg-2-1)) | 1793 | ((looking-at (rst-re 'ado-beg-2-1)) |
| 1794 | ;; Adornment found - consider it. | ||
| 1288 | (let ((char (string-to-char (match-string-no-properties 2))) | 1795 | (let ((char (string-to-char (match-string-no-properties 2))) |
| 1289 | (r (rst-classify-adornment (match-string-no-properties 0) | 1796 | (r (rst-classify-adornment (match-string-no-properties 0) |
| 1290 | (match-end 0)))) | 1797 | (match-end 0)))) |
| 1291 | (cond | 1798 | (cond |
| 1292 | ((not r) | 1799 | ((not r) |
| 1293 | ;; Invalid adornment - check whether this is an incomplete overline. | 1800 | ;; Invalid adornment - check whether this is an overline with |
| 1801 | ;; missing underline. | ||
| 1294 | (if (and | 1802 | (if (and |
| 1295 | (zerop (forward-line 1)) | 1803 | (zerop (forward-line 1)) |
| 1296 | (looking-at (rst-re 'ttl-beg))) | 1804 | (looking-at (rst-re 'ttl-beg-1))) |
| 1297 | (list (cons char nil) orig-pnt (line-end-position) | 1805 | (rst-Ttl-new (rst-Ado-new-over-and-under char) |
| 1298 | orig-pnt orig-end (point) (line-end-position) nil nil))) | 1806 | (list orig-pnt (line-end-position) |
| 1299 | ((consp (car r)) | 1807 | orig-pnt orig-end |
| 1300 | ;; A section title - not a transition. | 1808 | (point) (line-end-position) |
| 1301 | r)))) | 1809 | nil nil) |
| 1810 | (current-indentation) | ||
| 1811 | (match-string-no-properties 1)))) | ||
| 1812 | ((rst-Ado-is-transition (rst-Ttl-ado r)) | ||
| 1813 | nil) | ||
| 1814 | ;; Return any other classification as is. | ||
| 1815 | (r)))) | ||
| 1302 | ((looking-at (rst-re 'lin-end)) | 1816 | ((looking-at (rst-re 'lin-end)) |
| 1817 | ;; Empty line found - check surrounding lines for a title. | ||
| 1303 | (or | 1818 | (or |
| 1304 | (save-excursion | 1819 | (save-excursion |
| 1305 | (if (and (zerop (forward-line -1)) | 1820 | (if (and (zerop (forward-line -1)) |
| 1306 | (looking-at (rst-re 'ttl-beg))) | 1821 | (looking-at (rst-re 'ttl-beg-1))) |
| 1307 | (list (cons nil nil) (point) (line-end-position) | 1822 | (rst-Ttl-new nil |
| 1308 | nil nil (point) (line-end-position) nil nil))) | 1823 | (list (point) (line-end-position) |
| 1824 | nil nil | ||
| 1825 | (point) (line-end-position) | ||
| 1826 | nil nil) | ||
| 1827 | (current-indentation) | ||
| 1828 | (match-string-no-properties 1)))) | ||
| 1309 | (save-excursion | 1829 | (save-excursion |
| 1310 | (if (and (zerop (forward-line 1)) | 1830 | (if (and (zerop (forward-line 1)) |
| 1311 | (looking-at (rst-re 'ttl-beg))) | 1831 | (looking-at (rst-re 'ttl-beg-1))) |
| 1312 | (list (cons nil nil) (point) (line-end-position) | 1832 | (rst-Ttl-new nil |
| 1313 | nil nil (point) (line-end-position) nil nil))))) | 1833 | (list (point) (line-end-position) |
| 1314 | ((looking-at (rst-re 'ttl-beg)) | 1834 | nil nil |
| 1315 | ;; Try to use the underline. | 1835 | (point) (line-end-position) |
| 1316 | (let ((r (rst-classify-adornment | 1836 | nil nil) |
| 1317 | (buffer-substring-no-properties | 1837 | (current-indentation) |
| 1318 | (line-beginning-position 2) (line-end-position 2)) | 1838 | (match-string-no-properties 1)))))) |
| 1319 | (line-end-position 2)))) | 1839 | ((looking-at (rst-re 'ttl-beg-1)) |
| 1320 | (if r | 1840 | ;; Title line found - check for a following underline. |
| 1321 | r | 1841 | (let ((txt (match-string-no-properties 1))) |
| 1322 | ;; No valid adornment found. | 1842 | (or (rst-classify-adornment |
| 1323 | (list (cons nil nil) (point) (line-end-position) | 1843 | (buffer-substring-no-properties |
| 1324 | nil nil (point) (line-end-position) nil nil)))))))) | 1844 | (line-beginning-position 2) (line-end-position 2)) |
| 1845 | (line-end-position 2)) | ||
| 1846 | ;; No valid adornment found. | ||
| 1847 | (rst-Ttl-new nil | ||
| 1848 | (list (point) (line-end-position) | ||
| 1849 | nil nil | ||
| 1850 | (point) (line-end-position) | ||
| 1851 | nil nil) | ||
| 1852 | (current-indentation) | ||
| 1853 | txt)))))))) | ||
| 1325 | 1854 | ||
| 1326 | ;; The following function and variables are used to maintain information about | 1855 | ;; The following function and variables are used to maintain information about |
| 1327 | ;; current section adornment in a buffer local cache. Thus they can be used for | 1856 | ;; current section adornment in a buffer local cache. Thus they can be used for |
| 1328 | ;; font-locking and manipulation commands. | 1857 | ;; font-locking and manipulation commands. |
| 1329 | 1858 | ||
| 1330 | (defvar rst-all-sections nil | 1859 | (defvar rst-all-ttls-cache nil |
| 1331 | "All section adornments in the buffer as found by `rst-find-all-adornments'. | 1860 | "All section adornments in the buffer as found by `rst-all-ttls'. |
| 1332 | Set to t when no section adornments were found.") | 1861 | Set to t when no section adornments were found.") |
| 1333 | (make-variable-buffer-local 'rst-all-sections) | 1862 | (make-variable-buffer-local 'rst-all-ttls-cache) |
| 1334 | 1863 | ||
| 1335 | ;; FIXME: If this variable is set to a different value font-locking of section | 1864 | ;; FIXME: If this variable is set to a different value font-locking of section |
| 1336 | ;; headers is wrong. | 1865 | ;; headers is wrong. |
| 1337 | (defvar rst-section-hierarchy nil | 1866 | (defvar rst-hdr-hierarchy-cache nil |
| 1338 | "Section hierarchy in the buffer as determined by `rst-get-hierarchy'. | 1867 | "Section hierarchy in the buffer as determined by `rst-hdr-hierarchy'. |
| 1339 | Set to t when no section adornments were found. | 1868 | Set to t when no section adornments were found. |
| 1340 | Value depends on `rst-all-sections'.") | 1869 | Value depends on `rst-all-ttls-cache'.") |
| 1341 | (make-variable-buffer-local 'rst-section-hierarchy) | 1870 | (make-variable-buffer-local 'rst-hdr-hierarchy-cache) |
| 1342 | 1871 | ||
| 1343 | (rst-testcover-add-1value 'rst-reset-section-caches) | 1872 | (rst-testcover-add-1value 'rst-reset-section-caches) |
| 1344 | (defun rst-reset-section-caches () | 1873 | (defun rst-reset-section-caches () |
| 1345 | "Reset all section cache variables. | 1874 | "Reset all section cache variables. |
| 1346 | Should be called by interactive functions which deal with sections." | 1875 | Should be called by interactive functions which deal with sections." |
| 1347 | (setq rst-all-sections nil | 1876 | (setq rst-all-ttls-cache nil |
| 1348 | rst-section-hierarchy nil)) | 1877 | rst-hdr-hierarchy-cache nil)) |
| 1349 | 1878 | ||
| 1350 | (defun rst-find-all-adornments () | 1879 | (defun rst-all-ttls () |
| 1351 | "Return all the section adornments in the current buffer. | 1880 | "Return all the section adornments in the current buffer. |
| 1352 | Return a list of (LINE . ADORNMENT) with ascending LINE where | 1881 | Return a list of `rst-Ttl' with ascending line number. |
| 1353 | LINE is the line containing the section title. ADORNMENT consists | ||
| 1354 | of a (CHARACTER STYLE INDENT) triple as described for | ||
| 1355 | `rst-preferred-adornments'. | ||
| 1356 | 1882 | ||
| 1357 | Uses and sets `rst-all-sections'." | 1883 | Uses and sets `rst-all-ttls-cache'." |
| 1358 | (unless rst-all-sections | 1884 | (unless rst-all-ttls-cache |
| 1359 | (let (positions) | 1885 | (let (positions) |
| 1360 | ;; Iterate over all the section titles/adornments in the file. | 1886 | ;; Iterate over all the section titles/adornments in the file. |
| 1361 | (save-excursion | 1887 | (save-excursion |
| 1362 | (goto-char (point-min)) | 1888 | (save-match-data |
| 1363 | (while (re-search-forward (rst-re 'ado-beg-2-1) nil t) | 1889 | (goto-char (point-min)) |
| 1364 | (let ((ado-data (rst-classify-adornment | 1890 | (while (re-search-forward (rst-re 'ado-beg-2-1) nil t) |
| 1365 | (match-string-no-properties 0) (point)))) | 1891 | (let ((ttl (rst-classify-adornment |
| 1366 | (when (and ado-data | 1892 | (match-string-no-properties 0) (point)))) |
| 1367 | (consp (car ado-data))) ; Ignore transitions. | 1893 | (when (and ttl (rst-Ado-is-section (rst-Ttl-ado ttl))) |
| 1368 | (set-match-data (cdr ado-data)) | 1894 | (when (rst-Ttl-evaluate-hdr ttl) |
| 1369 | (goto-char (match-beginning 2)) ; Goto the title start. | 1895 | (push ttl positions)) |
| 1370 | (push (cons (1+ (count-lines (point-min) (point))) | 1896 | (goto-char (rst-Ttl-get-end ttl))))) |
| 1371 | (list (caar ado-data) | 1897 | (setq positions (nreverse positions)) |
| 1372 | (cdar ado-data) | 1898 | (setq rst-all-ttls-cache (or positions t)))))) |
| 1373 | (current-indentation))) | 1899 | (if (eq rst-all-ttls-cache t) |
| 1374 | positions) | ||
| 1375 | (goto-char (match-end 0))))) ; Go beyond the whole thing. | ||
| 1376 | (setq positions (nreverse positions)) | ||
| 1377 | (setq rst-all-sections (or positions t))))) | ||
| 1378 | (if (eq rst-all-sections t) | ||
| 1379 | nil | 1900 | nil |
| 1380 | rst-all-sections)) | 1901 | (mapcar 'rst-Ttl-copy rst-all-ttls-cache))) |
| 1381 | 1902 | ||
| 1382 | (defun rst-infer-hierarchy (adornments) | 1903 | (defun rst-infer-hdr-hierarchy (hdrs) |
| 1383 | "Build a hierarchy of adornments using the list of given ADORNMENTS. | 1904 | "Build a hierarchy from HDRS. |
| 1384 | 1905 | HDRS reflects the order in which the headers appear in the | |
| 1385 | ADORNMENTS is a list of (CHARACTER STYLE INDENT) adornment | 1906 | buffer. Return a `rst-Hdr' list representing the hierarchy of |
| 1386 | specifications, in order that they appear in a file, and will | 1907 | headers in the buffer. Indentation is unified." |
| 1387 | infer a hierarchy of section levels by removing adornments that | 1908 | (let (ado2indents) |
| 1388 | have already been seen in a forward traversal of the adornments, | 1909 | (dolist (hdr hdrs) |
| 1389 | comparing just CHARACTER and STYLE. | 1910 | (let* ((ado (rst-Hdr-ado hdr)) |
| 1390 | 1911 | (indent (rst-Hdr-indent hdr)) | |
| 1391 | Similarly returns a list of (CHARACTER STYLE INDENT), where each | 1912 | (found (assoc ado ado2indents))) |
| 1392 | list element should be unique." | 1913 | (if found |
| 1393 | (let (hierarchy-alist) | 1914 | (unless (member indent (cdr found)) |
| 1394 | (dolist (x adornments) | 1915 | ;; Append newly found indent. |
| 1395 | (let ((char (car x)) | 1916 | (setcdr found (append (cdr found) (list indent)))) |
| 1396 | (style (cadr x))) | 1917 | (push (list ado indent) ado2indents)))) |
| 1397 | (unless (assoc (cons char style) hierarchy-alist) | 1918 | (mapcar (lambda (ado_indents) |
| 1398 | (push (cons (cons char style) x) hierarchy-alist)))) | 1919 | (let ((ado (car ado_indents)) |
| 1399 | (mapcar 'cdr (nreverse hierarchy-alist)))) | 1920 | (indents (cdr ado_indents))) |
| 1400 | 1921 | (rst-Hdr-new | |
| 1401 | (defun rst-get-hierarchy (&optional ignore) | 1922 | ado |
| 1402 | "Return the hierarchy of section titles in the file. | 1923 | (if (> (length indents) 1) |
| 1403 | 1924 | ;; Indentations used inconsistently - use default. | |
| 1404 | Return a list of adornments that represents the hierarchy of | 1925 | rst-default-indent |
| 1405 | section titles in the file. Each element consists of (CHARACTER | 1926 | ;; Only one indentation used - use this. |
| 1406 | STYLE INDENT) as described for `rst-find-all-adornments'. If the | 1927 | (car indents))))) |
| 1407 | line number in IGNORE is specified, a possibly adornment found on | 1928 | (nreverse ado2indents)))) |
| 1408 | that line is not taken into account when building the hierarchy. | 1929 | |
| 1409 | 1930 | (defun rst-hdr-hierarchy (&optional ignore-current) | |
| 1410 | Uses and sets `rst-section-hierarchy' unless IGNORE is given." | 1931 | "Return the hierarchy of section titles in the file as a `rst-Hdr' list. |
| 1411 | (if (and (not ignore) rst-section-hierarchy) | 1932 | Each returned element may be used directly to create a section |
| 1412 | (if (eq rst-section-hierarchy t) | 1933 | adornment on that level. If IGNORE-CURRENT a title found on the |
| 1413 | nil | 1934 | current line is not taken into account when building the |
| 1414 | rst-section-hierarchy) | 1935 | hierarchy unless it appears again elsewhere. This catches cases |
| 1415 | (let ((r (rst-infer-hierarchy | 1936 | where the current title is edited and may not be final regarding |
| 1416 | (mapcar 'cdr | 1937 | its level. |
| 1417 | (assq-delete-all | 1938 | |
| 1418 | ignore | 1939 | Uses and sets `rst-hdr-hierarchy-cache' unless IGNORE-CURRENT is |
| 1419 | (rst-find-all-adornments)))))) | 1940 | given." |
| 1420 | (setq rst-section-hierarchy | 1941 | (let* ((all-ttls (rst-all-ttls)) |
| 1421 | (if ignore | 1942 | (ignore-position (if ignore-current |
| 1422 | ;; Clear cache reflecting that a possible update is not | 1943 | (line-beginning-position))) |
| 1423 | ;; reflected. | 1944 | (ignore-ttl |
| 1424 | nil | 1945 | (if ignore-position |
| 1425 | (or r t))) | 1946 | (car (member-if |
| 1426 | r))) | 1947 | (lambda (ttl) |
| 1427 | 1948 | (equal ignore-position (rst-Ttl-get-title-beginning ttl))) | |
| 1428 | (defun rst-get-adornments-around () | 1949 | all-ttls)))) |
| 1429 | "Return the adornments around point. | 1950 | (really-ignore |
| 1430 | Return a list of the previous and next adornments." | 1951 | (if ignore-ttl |
| 1431 | (let* ((all (rst-find-all-adornments)) | 1952 | (<= (count-if |
| 1432 | (curline (line-number-at-pos)) | 1953 | (lambda (ttl) |
| 1433 | prev next | 1954 | (rst-Ado-equal (rst-Ttl-ado ignore-ttl) (rst-Ttl-ado ttl))) |
| 1434 | (cur all)) | 1955 | all-ttls) |
| 1956 | 1))) | ||
| 1957 | (real-ttls (delq (if really-ignore ignore-ttl) all-ttls))) | ||
| 1958 | (mapcar ;; Protect cache. | ||
| 1959 | 'rst-Hdr-copy | ||
| 1960 | (if (and (not ignore-current) rst-hdr-hierarchy-cache) | ||
| 1961 | (if (eq rst-hdr-hierarchy-cache t) | ||
| 1962 | nil | ||
| 1963 | rst-hdr-hierarchy-cache) | ||
| 1964 | (let ((r (rst-infer-hdr-hierarchy (mapcar 'rst-Ttl-hdr real-ttls)))) | ||
| 1965 | (setq rst-hdr-hierarchy-cache | ||
| 1966 | (if ignore-current | ||
| 1967 | ;; Clear cache reflecting that a possible update is not | ||
| 1968 | ;; reflected. | ||
| 1969 | nil | ||
| 1970 | (or r t))) | ||
| 1971 | r))))) | ||
| 1972 | |||
| 1973 | (defun rst-all-ttls-with-level () | ||
| 1974 | "Return the section adornments with levels set according to hierarchy. | ||
| 1975 | Return a list of `rst-Ttl' with ascending line number." | ||
| 1976 | (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) | ||
| 1977 | (mapcar | ||
| 1978 | (lambda (ttl) | ||
| 1979 | (rst-Ttl-set-level ttl (rst-Ado-position (rst-Ttl-ado ttl) hier)) | ||
| 1980 | ttl) | ||
| 1981 | (rst-all-ttls)))) | ||
| 1982 | |||
| 1983 | (defun rst-get-previous-hdr () | ||
| 1984 | "Return the `rst-Hdr' before point or nil if none." | ||
| 1985 | (let ((ttls (rst-all-ttls)) | ||
| 1986 | (curpos (line-beginning-position)) | ||
| 1987 | prev) | ||
| 1435 | 1988 | ||
| 1436 | ;; Search for the adornments around the current line. | 1989 | ;; Search for the adornments around the current line. |
| 1437 | (while (and cur (< (caar cur) curline)) | 1990 | (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) curpos)) |
| 1438 | (setq prev cur | 1991 | (setq prev (car ttls) |
| 1439 | cur (cdr cur))) | 1992 | ttls (cdr ttls))) |
| 1440 | ;; 'cur' is the following adornment. | 1993 | (and prev (rst-Ttl-hdr prev)))) |
| 1441 | 1994 | ||
| 1442 | (if (and cur (caar cur)) | 1995 | (defun rst-adornment-complete-p (ado indent) |
| 1443 | (setq next (if (= curline (caar cur)) (cdr cur) cur))) | 1996 | "Return true if the adornment ADO around point is complete using INDENT. |
| 1444 | 1997 | The adornment is complete if it is a completely correct | |
| 1445 | (mapcar 'cdar (list prev next)))) | 1998 | reStructuredText adornment for the title line at point. This |
| 1446 | 1999 | includes indentation and correct length of adornment lines." | |
| 1447 | (defun rst-adornment-complete-p (ado) | ||
| 1448 | "Return true if the adornment ADO around point is complete." | ||
| 1449 | ;; Note: we assume that the detection of the overline as being the underline | 2000 | ;; Note: we assume that the detection of the overline as being the underline |
| 1450 | ;; of a preceding title has already been detected, and has been eliminated | 2001 | ;; of a preceding title has already been detected, and has been eliminated |
| 1451 | ;; from the adornment that is given to us. | 2002 | ;; from the adornment that is given to us. |
| 1452 | 2003 | (let ((exps (rst-re "^" (rst-Ado-char ado) | |
| 1453 | ;; There is some sectioning already present, so check if the current | 2004 | (format "\\{%d\\}" |
| 1454 | ;; sectioning is complete and correct. | 2005 | (+ (save-excursion |
| 1455 | (let* ((char (car ado)) | 2006 | ;; Determine last column of title. |
| 1456 | (style (cadr ado)) | 2007 | (end-of-line) |
| 1457 | (indent (caddr ado)) | 2008 | (current-column)) |
| 1458 | (endcol (save-excursion (end-of-line) (current-column)))) | 2009 | indent)) "$"))) |
| 1459 | (if char | 2010 | (and |
| 1460 | (let ((exps (rst-re "^" char (format "\\{%d\\}" (+ endcol indent)) "$"))) | 2011 | (save-excursion (forward-line +1) |
| 1461 | (and | 2012 | (looking-at exps)) |
| 1462 | (save-excursion (forward-line +1) | 2013 | (or (rst-Ado-is-simple ado) |
| 1463 | (beginning-of-line) | 2014 | (save-excursion (forward-line -1) |
| 1464 | (looking-at exps)) | 2015 | (looking-at exps)))))) |
| 1465 | (or (not (eq style 'over-and-under)) | 2016 | |
| 1466 | (save-excursion (forward-line -1) | 2017 | (defun rst-next-hdr (hdr hier prev down) |
| 1467 | (beginning-of-line) | 2018 | ;; testcover: ok. |
| 1468 | (looking-at exps)))))))) | 2019 | "Return the next best `rst-Hdr' upward from HDR. |
| 1469 | 2020 | Consider existing hierarchy HIER and preferred headers. PREV may | |
| 1470 | 2021 | be a previous `rst-Hdr' which may be taken into account. If DOWN | |
| 1471 | (defun rst-get-next-adornment | 2022 | return the next best `rst-Hdr' downward instead. Return nil in |
| 1472 | (curado hier &optional suggestion reverse-direction) | 2023 | HIER is nil." |
| 1473 | "Get the next adornment for CURADO, in given hierarchy HIER. | 2024 | (let* ((normalized-hier (if down |
| 1474 | If suggesting, suggest for new adornment SUGGESTION. | 2025 | hier |
| 1475 | REVERSE-DIRECTION is used to reverse the cycling order." | 2026 | (reverse hier))) |
| 1476 | 2027 | (fnd (rst-Hdr-member-ado hdr normalized-hier)) | |
| 1477 | (let* ( | 2028 | (prev-fnd (and prev (rst-Hdr-member-ado prev normalized-hier)))) |
| 1478 | (char (car curado)) | ||
| 1479 | (style (cadr curado)) | ||
| 1480 | |||
| 1481 | ;; Build a new list of adornments for the rotation. | ||
| 1482 | (rotados | ||
| 1483 | (append hier | ||
| 1484 | ;; Suggest a new adornment. | ||
| 1485 | (list suggestion | ||
| 1486 | ;; If nothing to suggest, use first adornment. | ||
| 1487 | (car hier)))) ) | ||
| 1488 | (or | 2029 | (or |
| 1489 | ;; Search for next adornment. | 2030 | ;; Next entry in existing hierarchy if it exists. |
| 1490 | (cadr | 2031 | (cadr fnd) |
| 1491 | (let ((cur (if reverse-direction rotados | 2032 | (if fnd |
| 1492 | (reverse rotados)))) | 2033 | ;; If current header is found try introducing a new one from preferred |
| 1493 | (while (and cur | 2034 | ;; hierarchy. |
| 1494 | (not (and (eq char (caar cur)) | 2035 | (rst-new-preferred-hdr hier prev) |
| 1495 | (eq style (cadar cur))))) | 2036 | ;; If not found try using previous header. |
| 1496 | (setq cur (cdr cur))) | 2037 | (if down |
| 1497 | cur)) | 2038 | (cadr prev-fnd) |
| 1498 | 2039 | (car prev-fnd))) | |
| 1499 | ;; If not found, take the first of all adornments. | 2040 | ;; All failed - rotate by using first from normalized existing hierarchy. |
| 1500 | suggestion))) | 2041 | (car normalized-hier)))) |
| 1501 | |||
| 1502 | 2042 | ||
| 1503 | ;; FIXME: A line "``/`` full" is not accepted as a section title. | 2043 | ;; FIXME: A line "``/`` full" is not accepted as a section title. |
| 1504 | (defun rst-adjust (pfxarg) | 2044 | (defun rst-adjust (pfxarg) |
| 1505 | "Auto-adjust the adornment around point. | 2045 | "Auto-adjust the adornment around point. |
| 1506 | |||
| 1507 | Adjust/rotate the section adornment for the section title around | 2046 | Adjust/rotate the section adornment for the section title around |
| 1508 | point or promote/demote the adornments inside the region, | 2047 | point or promote/demote the adornments inside the region, |
| 1509 | depending on whether the region is active. This function is meant | 2048 | depending on whether the region is active. This function is meant |
| @@ -1516,12 +2055,9 @@ the adornments of a section title in reStructuredText. It tries | |||
| 1516 | to deal with all the possible cases gracefully and to do \"the | 2055 | to deal with all the possible cases gracefully and to do \"the |
| 1517 | right thing\" in all cases. | 2056 | right thing\" in all cases. |
| 1518 | 2057 | ||
| 1519 | See the documentations of `rst-adjust-adornment-work' and | 2058 | See the documentations of `rst-adjust-section' and |
| 1520 | `rst-promote-region' for full details. | 2059 | `rst-promote-region' for full details. |
| 1521 | 2060 | ||
| 1522 | Prefix Arguments | ||
| 1523 | ================ | ||
| 1524 | |||
| 1525 | The method can take either (but not both) of | 2061 | The method can take either (but not both) of |
| 1526 | 2062 | ||
| 1527 | a. a (non-negative) prefix argument, which means to toggle the | 2063 | a. a (non-negative) prefix argument, which means to toggle the |
| @@ -1542,11 +2078,15 @@ b. a negative numerical argument, which generally inverts the | |||
| 1542 | ;; Adjust adornments within region. | 2078 | ;; Adjust adornments within region. |
| 1543 | (rst-promote-region (and pfxarg t)) | 2079 | (rst-promote-region (and pfxarg t)) |
| 1544 | ;; Adjust adornment around point. | 2080 | ;; Adjust adornment around point. |
| 1545 | (rst-adjust-adornment-work toggle-style reverse-direction)) | 2081 | (let ((msg (rst-adjust-section toggle-style reverse-direction))) |
| 2082 | (when msg | ||
| 2083 | (apply 'message msg)))) | ||
| 1546 | 2084 | ||
| 1547 | ;; Run the hooks to run after adjusting. | 2085 | ;; Run the hooks to run after adjusting. |
| 1548 | (run-hooks 'rst-adjust-hook) | 2086 | (run-hooks 'rst-adjust-hook) |
| 1549 | 2087 | ||
| 2088 | (rst-reset-section-caches) | ||
| 2089 | |||
| 1550 | ;; Make sure to reset the cursor position properly after we're done. | 2090 | ;; Make sure to reset the cursor position properly after we're done. |
| 1551 | (goto-char origpt))) | 2091 | (goto-char origpt))) |
| 1552 | 2092 | ||
| @@ -1567,31 +2107,23 @@ b. a negative numerical argument, which generally inverts the | |||
| 1567 | (rst-testcover-defcustom) | 2107 | (rst-testcover-defcustom) |
| 1568 | 2108 | ||
| 1569 | (defun rst-adjust-adornment (pfxarg) | 2109 | (defun rst-adjust-adornment (pfxarg) |
| 1570 | "Call `rst-adjust-adornment-work' interactively. | 2110 | "Call `rst-adjust-section' interactively. |
| 1571 | |||
| 1572 | Keep this for compatibility for older bindings (are there any?). | 2111 | Keep this for compatibility for older bindings (are there any?). |
| 1573 | Argument PFXARG has the same meaning as for `rst-adjust'." | 2112 | Argument PFXARG has the same meaning as for `rst-adjust'." |
| 1574 | (interactive "P") | 2113 | (interactive "P") |
| 1575 | 2114 | ||
| 1576 | (let* ((reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0))) | 2115 | (let* ((reverse-direction (and pfxarg (< (prefix-numeric-value pfxarg) 0))) |
| 1577 | (toggle-style (and pfxarg (not reverse-direction)))) | 2116 | (toggle-style (and pfxarg (not reverse-direction)))) |
| 1578 | (rst-adjust-adornment-work toggle-style reverse-direction))) | 2117 | (rst-adjust-section toggle-style reverse-direction))) |
| 1579 | 2118 | ||
| 1580 | (defun rst-adjust-adornment-work (toggle-style reverse-direction) | 2119 | (defun rst-adjust-section (toggle-style reverse) |
| 1581 | "Adjust/rotate the section adornment for the section title around point. | 2120 | "Adjust/rotate the section adornment for the section title around point. |
| 2121 | The action this function takes depends on context around the | ||
| 2122 | point, and it is meant to be invoked possibly more than once to | ||
| 2123 | rotate among the various possibilities. Basically, this function | ||
| 2124 | deals with: | ||
| 1582 | 2125 | ||
| 1583 | This function is meant to be invoked possibly multiple times, and | 2126 | - adding an adornment if the title does not have one; |
| 1584 | can vary its behavior with a true TOGGLE-STYLE argument, or with | ||
| 1585 | a REVERSE-DIRECTION argument. | ||
| 1586 | |||
| 1587 | General Behavior | ||
| 1588 | ================ | ||
| 1589 | |||
| 1590 | The next action it takes depends on context around the point, and | ||
| 1591 | it is meant to be invoked possibly more than once to rotate among | ||
| 1592 | the various possibilities. Basically, this function deals with: | ||
| 1593 | |||
| 1594 | - adding a adornment if the title does not have one; | ||
| 1595 | 2127 | ||
| 1596 | - adjusting the length of the underline characters to fit a | 2128 | - adjusting the length of the underline characters to fit a |
| 1597 | modified title; | 2129 | modified title; |
| @@ -1599,316 +2131,242 @@ the various possibilities. Basically, this function deals with: | |||
| 1599 | - rotating the adornment in the set of already existing | 2131 | - rotating the adornment in the set of already existing |
| 1600 | sectioning adornments used in the file; | 2132 | sectioning adornments used in the file; |
| 1601 | 2133 | ||
| 1602 | - switching between simple and over-and-under styles. | 2134 | - switching between simple and over-and-under styles by giving |
| 1603 | 2135 | TOGGLE-STYLE. | |
| 1604 | You should normally not have to read all the following, just | ||
| 1605 | invoke the method and it will do the most obvious thing that you | ||
| 1606 | would expect. | ||
| 1607 | |||
| 1608 | |||
| 1609 | Adornment Definitions | ||
| 1610 | ===================== | ||
| 1611 | |||
| 1612 | The adornments consist in | ||
| 1613 | |||
| 1614 | 1. a CHARACTER | ||
| 1615 | |||
| 1616 | 2. a STYLE which can be either `simple' or `over-and-under'. | ||
| 1617 | |||
| 1618 | 3. an INDENT (meaningful for the over-and-under style only) | ||
| 1619 | which determines how many characters and over-and-under | ||
| 1620 | style is hanging outside of the title at the beginning and | ||
| 1621 | ending. | ||
| 1622 | |||
| 1623 | See source code for mode details. | ||
| 1624 | |||
| 1625 | |||
| 1626 | Detailed Behavior Description | ||
| 1627 | ============================= | ||
| 1628 | |||
| 1629 | Here are the gory details of the algorithm (it seems quite | ||
| 1630 | complicated, but really, it does the most obvious thing in all | ||
| 1631 | the particular cases): | ||
| 1632 | |||
| 1633 | Before applying the adornment change, the cursor is placed on | ||
| 1634 | the closest line that could contain a section title. | ||
| 1635 | |||
| 1636 | Case 1: No Adornment | ||
| 1637 | -------------------- | ||
| 1638 | |||
| 1639 | If the current line has no adornment around it, | ||
| 1640 | |||
| 1641 | - search backwards for the last previous adornment, and apply | ||
| 1642 | the adornment one level lower to the current line. If there | ||
| 1643 | is no defined level below this previous adornment, we suggest | ||
| 1644 | the most appropriate of the `rst-preferred-adornments'. | ||
| 1645 | |||
| 1646 | If REVERSE-DIRECTION is true, we simply use the previous | ||
| 1647 | adornment found directly. | ||
| 1648 | |||
| 1649 | - if there is no adornment found in the given direction, we use | ||
| 1650 | the first of `rst-preferred-adornments'. | ||
| 1651 | 2136 | ||
| 1652 | TOGGLE-STYLE forces a toggle of the prescribed adornment style. | 2137 | Return nil if the function did something. If the function were |
| 2138 | not able to do something return an argument list for `message' to | ||
| 2139 | inform the user about what failed. | ||
| 1653 | 2140 | ||
| 1654 | Case 2: Incomplete Adornment | 2141 | The following is a detailed description but you should normally |
| 1655 | ---------------------------- | 2142 | not have to read it. |
| 1656 | 2143 | ||
| 1657 | If the current line does have an existing adornment, but the | 2144 | Before applying the adornment change, the cursor is placed on the |
| 1658 | adornment is incomplete, that is, the underline/overline does | 2145 | closest line that could contain a section title if such is found |
| 1659 | not extend to exactly the end of the title line (it is either | 2146 | around the cursor. Then the following cases are distinguished. |
| 1660 | too short or too long), we simply extend the length of the | ||
| 1661 | underlines/overlines to fit exactly the section title. | ||
| 1662 | 2147 | ||
| 1663 | If TOGGLE-STYLE we toggle the style of the adornment as well. | 2148 | * Case 1: No Adornment |
| 1664 | 2149 | ||
| 1665 | REVERSE-DIRECTION has no effect in this case. | 2150 | If the current line has no adornment around it, |
| 1666 | 2151 | ||
| 1667 | Case 3: Complete Existing Adornment | 2152 | - search for a previous adornment, and apply this adornment (unless |
| 1668 | ----------------------------------- | 2153 | `rst-new-adornment-down') or one level lower (otherwise) to the current |
| 2154 | line. If there is no defined level below this previous adornment, we | ||
| 2155 | suggest the most appropriate of the `rst-preferred-adornments'. | ||
| 1669 | 2156 | ||
| 1670 | If the adornment is complete (i.e. the underline (overline) | 2157 | If REVERSE is true, we simply use the previous adornment found |
| 1671 | length is already adjusted to the end of the title line), we | 2158 | directly. |
| 1672 | search/parse the file to establish the hierarchy of all the | ||
| 1673 | adornments (making sure not to include the adornment around | ||
| 1674 | point), and we rotate the current title's adornment from within | ||
| 1675 | that list (by default, going *down* the hierarchy that is present | ||
| 1676 | in the file, i.e. to a lower section level). This is meant to be | ||
| 1677 | used potentially multiple times, until the desired adornment is | ||
| 1678 | found around the title. | ||
| 1679 | 2159 | ||
| 1680 | If we hit the boundary of the hierarchy, exactly one choice from | 2160 | - if there is no adornment found in the given direction, we use the first of |
| 1681 | the list of preferred adornments is suggested/chosen, the first | 2161 | `rst-preferred-adornments'. |
| 1682 | of those adornment that has not been seen in the file yet (and | ||
| 1683 | not including the adornment around point), and the next | ||
| 1684 | invocation rolls over to the other end of the hierarchy (i.e. it | ||
| 1685 | cycles). This allows you to avoid having to set which character | ||
| 1686 | to use. | ||
| 1687 | 2162 | ||
| 1688 | If REVERSE-DIRECTION is true, the effect is to change the | 2163 | TOGGLE-STYLE forces a toggle of the prescribed adornment style. |
| 1689 | direction of rotation in the hierarchy of adornments, thus | ||
| 1690 | instead going *up* the hierarchy. | ||
| 1691 | 2164 | ||
| 1692 | However, if TOGGLE-STYLE, we do not rotate the adornment, but | 2165 | * Case 2: Incomplete Adornment |
| 1693 | instead simply toggle the style of the current adornment (this | ||
| 1694 | should be the most common way to toggle the style of an existing | ||
| 1695 | complete adornment). | ||
| 1696 | 2166 | ||
| 2167 | If the current line does have an existing adornment, but the adornment is | ||
| 2168 | incomplete, that is, the underline/overline does not extend to exactly the | ||
| 2169 | end of the title line (it is either too short or too long), we simply extend | ||
| 2170 | the length of the underlines/overlines to fit exactly the section title. | ||
| 1697 | 2171 | ||
| 1698 | Point Location | 2172 | If TOGGLE-STYLE we toggle the style of the adornment as well. |
| 1699 | ============== | ||
| 1700 | 2173 | ||
| 1701 | The invocation of this function can be carried out anywhere | 2174 | REVERSE has no effect in this case. |
| 1702 | within the section title line, on an existing underline or | ||
| 1703 | overline, as well as on an empty line following a section title. | ||
| 1704 | This is meant to be as convenient as possible. | ||
| 1705 | 2175 | ||
| 2176 | * Case 3: Complete Existing Adornment | ||
| 1706 | 2177 | ||
| 1707 | Indented Sections | 2178 | If the adornment is complete (i.e. the underline (overline) length is already |
| 1708 | ================= | 2179 | adjusted to the end of the title line), we rotate the current title's |
| 2180 | adornment according to the adornment hierarchy found in the buffer. This is | ||
| 2181 | meant to be used potentially multiple times, until the desired adornment is | ||
| 2182 | found around the title. | ||
| 1709 | 2183 | ||
| 1710 | Indented section titles such as :: | 2184 | If we hit the boundary of the hierarchy, exactly one choice from the list of |
| 2185 | preferred adornments is suggested/chosen, the first of those adornment that | ||
| 2186 | has not been seen in the buffer yet, and the next invocation rolls over to | ||
| 2187 | the other end of the hierarchy (i.e. it cycles). | ||
| 1711 | 2188 | ||
| 1712 | My Title | 2189 | If REVERSE is we go up in the hierarchy. Otherwise we go down. |
| 1713 | -------- | ||
| 1714 | 2190 | ||
| 1715 | are invalid in reStructuredText and thus not recognized by the | 2191 | However, if TOGGLE-STYLE, we do not rotate the adornment, but instead simply |
| 1716 | parser. This code will thus not work in a way that would support | 2192 | toggle the style of the current adornment." |
| 1717 | indented sections (it would be ambiguous anyway). | ||
| 1718 | |||
| 1719 | |||
| 1720 | Joint Sections | ||
| 1721 | ============== | ||
| 1722 | |||
| 1723 | Section titles that are right next to each other may not be | ||
| 1724 | treated well. More work might be needed to support those, and | ||
| 1725 | special conditions on the completeness of existing adornments | ||
| 1726 | might be required to make it non-ambiguous. | ||
| 1727 | |||
| 1728 | For now we assume that the adornments are disjoint, that is, | ||
| 1729 | there is at least a single line between the titles/adornment | ||
| 1730 | lines." | ||
| 1731 | (rst-reset-section-caches) | 2193 | (rst-reset-section-caches) |
| 1732 | (let ((ttl-fnd (rst-find-title-line)) | 2194 | (let ((ttl (rst-ttl-at-point)) |
| 1733 | (orig-pnt (point))) | 2195 | (orig-pnt (point)) |
| 1734 | (when ttl-fnd | 2196 | msg) |
| 1735 | (set-match-data (cdr ttl-fnd)) | 2197 | (if (not ttl) |
| 1736 | (goto-char (match-beginning 2)) | 2198 | (setq msg '("No section header or candidate at point")) |
| 1737 | (let* ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt))) | 2199 | (goto-char (rst-Ttl-get-title-beginning ttl)) |
| 1738 | (char (caar ttl-fnd)) | 2200 | (let ((moved (- (line-number-at-pos) (line-number-at-pos orig-pnt))) |
| 1739 | (style (cdar ttl-fnd)) | 2201 | (found (rst-Ttl-ado ttl)) |
| 1740 | (indent (current-indentation)) | 2202 | (indent (rst-Ttl-indent ttl)) |
| 1741 | (curado (list char style indent)) | 2203 | (prev (rst-get-previous-hdr)) |
| 1742 | char-new style-new indent-new) | 2204 | new) |
| 1743 | (cond | 2205 | (when (and found (not (rst-Ado-p found))) |
| 1744 | ;;------------------------------------------------------------------- | 2206 | ;; Normalize found adornment - overline with no underline counts as |
| 1745 | ;; Case 1: No valid adornment | 2207 | ;; overline. |
| 1746 | ((not style) | 2208 | (setq found (rst-Ado-new-over-and-under found))) |
| 1747 | (let ((prev (car (rst-get-adornments-around))) | 2209 | (setq new |
| 1748 | cur | 2210 | (cond |
| 1749 | (hier (rst-get-hierarchy))) | 2211 | ((not found) |
| 1750 | ;; Advance one level down. | 2212 | ;; Case 1: No adornment at all. |
| 1751 | (setq cur | 2213 | (let ((hier (rst-hdr-hierarchy))) |
| 1752 | (if prev | 2214 | (if prev |
| 1753 | (if (or (and rst-new-adornment-down reverse-direction) | 2215 | ;; Previous header exists - use it. |
| 1754 | (and (not rst-new-adornment-down) | 2216 | (cond |
| 1755 | (not reverse-direction))) | 2217 | ;; Customization and parameters require that the |
| 1756 | prev | 2218 | ;; previous level is used - use it as is. |
| 1757 | (or (cadr (rst-get-adornment-match hier prev)) | 2219 | ((or (and rst-new-adornment-down reverse) |
| 1758 | (rst-suggest-new-adornment hier prev))) | 2220 | (and (not rst-new-adornment-down) (not reverse))) |
| 1759 | (copy-sequence (car rst-preferred-adornments)))) | 2221 | prev) |
| 1760 | ;; Invert the style if requested. | 2222 | ;; Advance one level down. |
| 1761 | (if toggle-style | 2223 | ((rst-next-hdr prev hier prev t)) |
| 1762 | (setcar (cdr cur) (if (eq (cadr cur) 'simple) | 2224 | (t |
| 1763 | 'over-and-under 'simple)) ) | 2225 | (setq msg '("Neither hierarchy nor preferences can suggest a deeper header")) |
| 1764 | (setq char-new (car cur) | 2226 | nil)) |
| 1765 | style-new (cadr cur) | 2227 | ;; First header in the buffer - use the first adornment |
| 1766 | indent-new (caddr cur)))) | 2228 | ;; from preferences or hierarchy. |
| 1767 | ;;------------------------------------------------------------------- | 2229 | (let ((p (car (rst-Hdr-preferred-adornments))) |
| 1768 | ;; Case 2: Incomplete Adornment | 2230 | (h (car hier))) |
| 1769 | ((not (rst-adornment-complete-p curado)) | 2231 | (cond |
| 1770 | ;; Invert the style if requested. | 2232 | ((if reverse |
| 1771 | (if toggle-style | 2233 | ;; Prefer hierarchy for downwards |
| 1772 | (setq style (if (eq style 'simple) 'over-and-under 'simple))) | 2234 | (or h p) |
| 1773 | (setq char-new char | 2235 | ;; Prefer preferences for upwards |
| 1774 | style-new style | 2236 | (or p h))) |
| 1775 | indent-new indent)) | 2237 | (t |
| 1776 | ;;------------------------------------------------------------------- | 2238 | (setq msg '("No preferences to suggest a top level from")) |
| 1777 | ;; Case 3: Complete Existing Adornment | 2239 | nil)))))) |
| 1778 | (t | 2240 | ((not (rst-adornment-complete-p found indent)) |
| 1779 | (if toggle-style | 2241 | ;; Case 2: Incomplete adornment. |
| 1780 | ;; Simply switch the style of the current adornment. | 2242 | ;; Use lax since indentation might not match suggestion. |
| 1781 | (setq char-new char | 2243 | (rst-Hdr-new-lax found indent)) |
| 1782 | style-new (if (eq style 'simple) 'over-and-under 'simple) | 2244 | ;; Case 3: Complete adornment exists from here on. |
| 1783 | indent-new rst-default-indent) | 2245 | (toggle-style |
| 1784 | ;; Else, we rotate, ignoring the adornment around the current | 2246 | ;; Simply switch the style of the current adornment. |
| 1785 | ;; line... | 2247 | (setq toggle-style nil) ;; Remember toggling has been done. |
| 1786 | (let* ((hier (rst-get-hierarchy (line-number-at-pos))) | 2248 | (rst-Hdr-new-invert found rst-default-indent)) |
| 1787 | ;; Suggestion, in case we need to come up with something new. | 2249 | (t |
| 1788 | (suggestion (rst-suggest-new-adornment | 2250 | ;; Rotate, ignoring a sole adornment around the current line. |
| 1789 | hier | 2251 | (let ((hier (rst-hdr-hierarchy t))) |
| 1790 | (car (rst-get-adornments-around)))) | 2252 | (cond |
| 1791 | (nextado (rst-get-next-adornment | 2253 | ;; Next header can be determined from hierarchy or |
| 1792 | curado hier suggestion reverse-direction))) | 2254 | ;; preferences. |
| 1793 | ;; Indent, if present, always overrides the prescribed indent. | 2255 | ((rst-next-hdr |
| 1794 | (setq char-new (car nextado) | 2256 | ;; Use lax since indentation might not match suggestion. |
| 1795 | style-new (cadr nextado) | 2257 | (rst-Hdr-new-lax found indent) hier prev reverse)) |
| 1796 | indent-new (caddr nextado)))))) | 2258 | ;; No next header found. |
| 1797 | ;; Override indent with present indent! | 2259 | (t |
| 1798 | (setq indent-new (if (> indent 0) indent indent-new)) | 2260 | (setq msg '("No preferences or hierarchy to suggest another level from")) |
| 1799 | (if (and char-new style-new) | 2261 | nil)))))) |
| 1800 | (rst-update-section char-new style-new indent-new)) | 2262 | (if (not new) |
| 1801 | ;; Correct the position of the cursor to more accurately reflect where | 2263 | (goto-char orig-pnt) |
| 1802 | ;; it was located when the function was invoked. | 2264 | (when toggle-style |
| 1803 | (unless (zerop moved) | 2265 | (setq new (rst-Hdr-new-invert (rst-Hdr-ado new) indent))) |
| 1804 | (forward-line (- moved)) | 2266 | ;; Override indent with present indent if there is some. |
| 1805 | (end-of-line)))))) | 2267 | (when (> indent 0) |
| 2268 | ;; Use lax since existing indent may not be valid for new style. | ||
| 2269 | (setq new (rst-Hdr-new-lax (rst-Hdr-ado new) indent))) | ||
| 2270 | (rst-update-section new) | ||
| 2271 | ;; Correct the position of the cursor to more accurately reflect where | ||
| 2272 | ;; it was located when the function was invoked. | ||
| 2273 | (unless (zerop moved) | ||
| 2274 | (forward-line (- moved)) | ||
| 2275 | (end-of-line))))) | ||
| 2276 | msg)) | ||
| 1806 | 2277 | ||
| 1807 | ;; Maintain an alias for compatibility. | 2278 | ;; Maintain an alias for compatibility. |
| 1808 | (defalias 'rst-adjust-section-title 'rst-adjust) | 2279 | (defalias 'rst-adjust-section-title 'rst-adjust) |
| 1809 | 2280 | ||
| 1810 | |||
| 1811 | (defun rst-promote-region (demote) | 2281 | (defun rst-promote-region (demote) |
| 1812 | "Promote the section titles within the region. | 2282 | "Promote the section titles within the region. |
| 1813 | |||
| 1814 | With argument DEMOTE or a prefix argument, demote the section | 2283 | With argument DEMOTE or a prefix argument, demote the section |
| 1815 | titles instead. The algorithm used at the boundaries of the | 2284 | titles instead. The algorithm used at the boundaries of the |
| 1816 | hierarchy is similar to that used by `rst-adjust-adornment-work'." | 2285 | hierarchy is similar to that used by `rst-adjust-section'." |
| 1817 | (interactive "P") | 2286 | (interactive "P") |
| 1818 | (rst-reset-section-caches) | 2287 | (rst-reset-section-caches) |
| 1819 | (let* ((cur (rst-find-all-adornments)) | 2288 | (let ((ttls (rst-all-ttls)) |
| 1820 | (hier (rst-get-hierarchy)) | 2289 | (hier (rst-hdr-hierarchy)) |
| 1821 | (suggestion (rst-suggest-new-adornment hier)) | 2290 | (region-beg (save-excursion |
| 1822 | 2291 | (goto-char (region-beginning)) | |
| 1823 | (region-begin-line (line-number-at-pos (region-beginning))) | 2292 | (line-beginning-position))) |
| 1824 | (region-end-line (line-number-at-pos (region-end))) | 2293 | (region-end (save-excursion |
| 1825 | 2294 | (goto-char (region-end)) | |
| 1826 | marker-list) | 2295 | (line-beginning-position))) |
| 2296 | marker-list) | ||
| 1827 | 2297 | ||
| 1828 | ;; Skip the markers that come before the region beginning. | 2298 | ;; Skip the markers that come before the region beginning. |
| 1829 | (while (and cur (< (caar cur) region-begin-line)) | 2299 | (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) region-beg)) |
| 1830 | (setq cur (cdr cur))) | 2300 | (setq ttls (cdr ttls))) |
| 1831 | 2301 | ||
| 1832 | ;; Create a list of markers for all the adornments which are found within | 2302 | ;; Create a list of markers for all the adornments which are found within |
| 1833 | ;; the region. | 2303 | ;; the region. |
| 1834 | (save-excursion | 2304 | (save-excursion |
| 1835 | (let (line) | 2305 | (while (and ttls (< (rst-Ttl-get-title-beginning (car ttls)) region-end)) |
| 1836 | (while (and cur (< (setq line (caar cur)) region-end-line)) | 2306 | (push (cons (copy-marker (rst-Ttl-get-title-beginning (car ttls))) |
| 1837 | (goto-char (point-min)) | 2307 | (rst-Ttl-hdr (car ttls))) marker-list) |
| 1838 | (forward-line (1- line)) | 2308 | (setq ttls (cdr ttls))) |
| 1839 | (push (list (point-marker) (cdar cur)) marker-list) | ||
| 1840 | (setq cur (cdr cur)) )) | ||
| 1841 | 2309 | ||
| 1842 | ;; Apply modifications. | 2310 | ;; Apply modifications. |
| 1843 | (dolist (p marker-list) | 2311 | (dolist (p marker-list) |
| 1844 | ;; Go to the adornment to promote. | 2312 | ;; Go to the adornment to promote. |
| 1845 | (goto-char (car p)) | 2313 | (goto-char (car p)) |
| 1846 | 2314 | ;; `rst-next-hdr' cannot return nil because we apply to a section | |
| 1847 | ;; Update the adornment. | 2315 | ;; header so there is some hierarchy. |
| 1848 | (apply 'rst-update-section | 2316 | (rst-update-section (rst-next-hdr (cdr p) hier nil demote)) |
| 1849 | ;; Rotate the next adornment. | ||
| 1850 | (rst-get-next-adornment | ||
| 1851 | (cadr p) hier suggestion demote)) | ||
| 1852 | 2317 | ||
| 1853 | ;; Clear marker to avoid slowing down the editing after we're done. | 2318 | ;; Clear marker to avoid slowing down the editing after we're done. |
| 1854 | (set-marker (car p) nil)) | 2319 | (set-marker (car p) nil)) |
| 1855 | (setq deactivate-mark nil)))) | 2320 | (setq deactivate-mark nil)))) |
| 1856 | 2321 | ||
| 1857 | 2322 | (defun rst-display-hdr-hierarchy () | |
| 1858 | |||
| 1859 | (defun rst-display-adornments-hierarchy (&optional adornments) | ||
| 1860 | "Display the current file's section title adornments hierarchy. | 2323 | "Display the current file's section title adornments hierarchy. |
| 1861 | This function expects a list of (CHARACTER STYLE INDENT) triples | 2324 | Hierarchy is displayed in a temporary buffer." |
| 1862 | in ADORNMENTS." | ||
| 1863 | (interactive) | 2325 | (interactive) |
| 1864 | (rst-reset-section-caches) | 2326 | (rst-reset-section-caches) |
| 1865 | (if (not adornments) | 2327 | (let ((hdrs (rst-hdr-hierarchy)) |
| 1866 | (setq adornments (rst-get-hierarchy))) | 2328 | (level 1)) |
| 1867 | (with-output-to-temp-buffer "*rest section hierarchy*" | 2329 | (with-output-to-temp-buffer "*rest section hierarchy*" |
| 1868 | (let ((level 1)) | ||
| 1869 | (with-current-buffer standard-output | 2330 | (with-current-buffer standard-output |
| 1870 | (dolist (x adornments) | 2331 | (dolist (hdr hdrs) |
| 1871 | (insert (format "\nSection Level %d" level)) | 2332 | (insert (format "\nSection Level %d" level)) |
| 1872 | (apply 'rst-update-section x) | 2333 | (rst-update-section hdr) |
| 1873 | (goto-char (point-max)) | 2334 | (goto-char (point-max)) |
| 1874 | (insert "\n") | 2335 | (insert "\n") |
| 1875 | (incf level)))))) | 2336 | (incf level)))))) |
| 1876 | 2337 | ||
| 1877 | (defun rst-straighten-adornments () | 2338 | ;; Maintain an alias for backward compatibility. |
| 1878 | "Redo all the adornments in the current buffer. | 2339 | (defalias 'rst-display-adornments-hierarchy 'rst-display-hdr-hierarchy) |
| 1879 | This is done using our preferred set of adornments. This can be | 2340 | |
| 2341 | ;; FIXME: Should accept an argument giving the hierarchy level to start with | ||
| 2342 | ;; instead of the top of the hierarchy. | ||
| 2343 | (defun rst-straighten-sections () | ||
| 2344 | "Redo the adornments of all section titles in the current buffer. | ||
| 2345 | This is done using the preferred set of adornments. This can be | ||
| 1880 | used, for example, when using somebody else's copy of a document, | 2346 | used, for example, when using somebody else's copy of a document, |
| 1881 | in order to adapt it to our preferred style." | 2347 | in order to adapt it to our preferred style." |
| 1882 | (interactive) | 2348 | (interactive) |
| 1883 | (rst-reset-section-caches) | 2349 | (rst-reset-section-caches) |
| 1884 | (save-excursion | 2350 | (save-excursion |
| 1885 | (let (;; Get a list of pairs of (level . marker). | 2351 | (dolist (ttl-marker (mapcar |
| 1886 | (levels-and-markers (mapcar | 2352 | (lambda (ttl) |
| 1887 | (lambda (ado) | 2353 | (cons ttl (copy-marker |
| 1888 | (cons (rst-position (cdr ado) | 2354 | (rst-Ttl-get-title-beginning ttl)))) |
| 1889 | (rst-get-hierarchy)) | 2355 | (rst-all-ttls-with-level))) |
| 1890 | (progn | 2356 | ;; Go to the appropriate position. |
| 1891 | (goto-char (point-min)) | 2357 | (goto-char (cdr ttl-marker)) |
| 1892 | (forward-line (1- (car ado))) | 2358 | (rst-update-section (nth (rst-Ttl-level (car ttl-marker)) |
| 1893 | (point-marker)))) | 2359 | (rst-Hdr-preferred-adornments))) |
| 1894 | (rst-find-all-adornments)))) | 2360 | ;; Reset the marker to avoid slowing down editing. |
| 1895 | (dolist (lm levels-and-markers) | 2361 | (set-marker (cdr ttl-marker) nil)))) |
| 1896 | ;; Go to the appropriate position. | 2362 | |
| 1897 | (goto-char (cdr lm)) | 2363 | ;; Maintain an alias for compatibility. |
| 1898 | 2364 | (defalias 'rst-straighten-adornments 'rst-straighten-sections) | |
| 1899 | ;; Apply the new style. | ||
| 1900 | (apply 'rst-update-section (nth (car lm) rst-preferred-adornments)) | ||
| 1901 | |||
| 1902 | ;; Reset the marker to avoid slowing down editing until it gets GC'ed. | ||
| 1903 | (set-marker (cdr lm) nil))))) | ||
| 1904 | 2365 | ||
| 1905 | 2366 | ||
| 1906 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 2367 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 1907 | ;; Insert list items | 2368 | ;; Insert list items |
| 1908 | ;; ================= | ||
| 1909 | |||
| 1910 | 2369 | ||
| 1911 | ;================================================= | ||
| 1912 | ; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <wence@gmx.li>. | 2370 | ; Borrowed from a2r.el (version 1.3), by Lawrence Mitchell <wence@gmx.li>. |
| 1913 | ; I needed to make some tiny changes to the functions, so I put it here. | 2371 | ; I needed to make some tiny changes to the functions, so I put it here. |
| 1914 | ; -- Wei-Wei Guo | 2372 | ; -- Wei-Wei Guo |
| @@ -1956,7 +2414,8 @@ If optional ARG is non-nil, insert in current buffer." | |||
| 1956 | string (replace-match "" nil t string)) | 2414 | string (replace-match "" nil t string)) |
| 1957 | (setq map (cdr map)))) | 2415 | (setq map (cdr map)))) |
| 1958 | (if arg (insert res) res))) | 2416 | (if arg (insert res) res))) |
| 1959 | ;================================================= | 2417 | |
| 2418 | ;; End of borrow. | ||
| 1960 | 2419 | ||
| 1961 | (defun rst-find-pfx-in-region (beg end pfx-re) | 2420 | (defun rst-find-pfx-in-region (beg end pfx-re) |
| 1962 | "Find all the positions of prefixes in region between BEG and END. | 2421 | "Find all the positions of prefixes in region between BEG and END. |
| @@ -2124,7 +2583,9 @@ If PREFER-ROMAN roman numbering is preferred over using letters." | |||
| 2124 | (1+ (string-to-char (match-string 0 curitem)))) | 2583 | (1+ (string-to-char (match-string 0 curitem)))) |
| 2125 | nil nil curitem))))) | 2584 | nil nil curitem))))) |
| 2126 | 2585 | ||
| 2127 | 2586 | ;; FIXME: At least the contiunation may be fold into | |
| 2587 | ;; `newline-and-indent`. However, this may not be wanted by everyone so | ||
| 2588 | ;; it should be possible to switch this off. | ||
| 2128 | (defun rst-insert-list (&optional prefer-roman) | 2589 | (defun rst-insert-list (&optional prefer-roman) |
| 2129 | "Insert a list item at the current point. | 2590 | "Insert a list item at the current point. |
| 2130 | 2591 | ||
| @@ -2197,112 +2658,57 @@ adjust. If bullets are found on levels beyond the | |||
| 2197 | 2658 | ||
| 2198 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 2659 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2199 | ;; Table of contents | 2660 | ;; Table of contents |
| 2200 | ;; ================= | 2661 | |
| 2201 | 2662 | (defun rst-all-stn () | |
| 2202 | ;; FIXME: Return value should be a `defstruct'. | 2663 | "Return the hierarchical tree of section titles as a top level `rst-Stn'. |
| 2203 | (defun rst-section-tree () | 2664 | Return nil for no section titles." |
| 2204 | "Return the hierarchical tree of section titles. | 2665 | ;; FIXME: The top level node may contain the document title instead of nil. |
| 2205 | A tree entry looks like ((TITLE MARKER) CHILD...). TITLE is the | 2666 | (cdr (rst-remaining-stn (rst-all-ttls-with-level) -1))) |
| 2206 | stripped text of the section title. MARKER is a marker for the | 2667 | |
| 2207 | beginning of the title text. For the top node or a missing | 2668 | (defun rst-remaining-stn (remaining lev) |
| 2208 | section level node TITLE is nil and MARKER points to the title | ||
| 2209 | text of the first child. Each CHILD is another tree entry. The | ||
| 2210 | CHILD list may be empty." | ||
| 2211 | (let ((hier (rst-get-hierarchy)) | ||
| 2212 | (ch-sty2level (make-hash-table :test 'equal :size 10)) | ||
| 2213 | lev-ttl-mrk-l) | ||
| 2214 | |||
| 2215 | (let ((lev 0)) | ||
| 2216 | (dolist (ado hier) | ||
| 2217 | ;; Compare just the character and indent in the hash table. | ||
| 2218 | (puthash (cons (car ado) (cadr ado)) lev ch-sty2level) | ||
| 2219 | (incf lev))) | ||
| 2220 | |||
| 2221 | ;; Create a list that contains (LEVEL TITLE MARKER) for each adornment. | ||
| 2222 | (save-excursion | ||
| 2223 | (setq lev-ttl-mrk-l | ||
| 2224 | (mapcar (lambda (ado) | ||
| 2225 | (goto-char (point-min)) | ||
| 2226 | (1value ;; This should really succeed. | ||
| 2227 | (forward-line (1- (car ado)))) | ||
| 2228 | (list (gethash (cons (cadr ado) (caddr ado)) ch-sty2level) | ||
| 2229 | ;; Get title. | ||
| 2230 | (save-excursion | ||
| 2231 | (if (re-search-forward | ||
| 2232 | (rst-re "\\S .*\\S ") (line-end-position) t) | ||
| 2233 | (buffer-substring-no-properties | ||
| 2234 | (match-beginning 0) (match-end 0)) | ||
| 2235 | "")) | ||
| 2236 | (point-marker))) | ||
| 2237 | (rst-find-all-adornments)))) | ||
| 2238 | (cdr (rst-section-tree-rec lev-ttl-mrk-l -1)))) | ||
| 2239 | |||
| 2240 | ;; FIXME: Return value should be a `defstruct'. | ||
| 2241 | (defun rst-section-tree-rec (remaining lev) | ||
| 2242 | "Process the first entry of REMAINING expected to be on level LEV. | 2669 | "Process the first entry of REMAINING expected to be on level LEV. |
| 2243 | REMAINING is the remaining list of adornments consisting | 2670 | REMAINING is the remaining list of `rst-Ttl' entries. |
| 2244 | of (LEVEL TITLE MARKER) entries. | 2671 | Return (UNPROCESSED . NODE) for the first entry of REMAINING. |
| 2245 | 2672 | UNPROCESSED is the list of still unprocessed entries. NODE is a | |
| 2246 | Return (UNPROCESSED (TITLE MARKER) CHILD...) for the first entry | 2673 | `rst-Stn' or nil if REMAINING is empty." |
| 2247 | of REMAINING where TITLE is nil if the expected level is not | 2674 | (let ((ttl (car remaining)) |
| 2248 | matched. UNPROCESSED is the list of still unprocessed entries. | ||
| 2249 | Each CHILD is a child of this entry in the same format but | ||
| 2250 | without UNPROCESSED." | ||
| 2251 | (let ((cur (car remaining)) | ||
| 2252 | (unprocessed remaining) | 2675 | (unprocessed remaining) |
| 2253 | ttl-mrk children) | 2676 | fnd children) |
| 2254 | ;; If the current adornment matches expected level. | 2677 | ;; If the current adornment matches expected level. |
| 2255 | (when (and cur (= (car cur) lev)) | 2678 | (when (and ttl (= (rst-Ttl-level ttl) lev)) |
| 2256 | ;; Consume the current entry and create the current node with it. | 2679 | ;; Consume the current entry and create the current node with it. |
| 2257 | (setq unprocessed (cdr remaining)) | 2680 | (setq unprocessed (cdr remaining)) |
| 2258 | (setq ttl-mrk (cdr cur))) | 2681 | (setq fnd ttl)) |
| 2259 | |||
| 2260 | ;; Build the child nodes as long as they have deeper level. | 2682 | ;; Build the child nodes as long as they have deeper level. |
| 2261 | (while (and unprocessed (> (caar unprocessed) lev)) | 2683 | (while (and unprocessed (> (rst-Ttl-level (car unprocessed)) lev)) |
| 2262 | (let ((rem-children (rst-section-tree-rec unprocessed (1+ lev)))) | 2684 | (let* ((rem-child (rst-remaining-stn unprocessed (1+ lev))) |
| 2263 | (setq children (cons (cdr rem-children) children)) | 2685 | (child (cdr rem-child))) |
| 2264 | (setq unprocessed (car rem-children)))) | 2686 | (when child |
| 2687 | (push child children)) | ||
| 2688 | (setq unprocessed (car rem-child)))) | ||
| 2265 | (setq children (reverse children)) | 2689 | (setq children (reverse children)) |
| 2266 | |||
| 2267 | (cons unprocessed | 2690 | (cons unprocessed |
| 2268 | (cons (or ttl-mrk | 2691 | (if (or fnd children) |
| 2269 | ;; Node on this level missing - use nil as text and the | 2692 | (rst-Stn-new fnd lev children))))) |
| 2270 | ;; marker of the first child. | 2693 | |
| 2271 | (cons nil (cdaar children))) | 2694 | (defun rst-stn-containing-point (stn &optional point) |
| 2272 | children)))) | 2695 | "Return `rst-Stn' in STN before POINT or nil if in no section. |
| 2273 | 2696 | POINT defaults to the current point. STN may be nil for no | |
| 2274 | (defun rst-section-tree-point (tree &optional point) | 2697 | section headers at all." |
| 2275 | "Return section containing POINT by returning the closest node in TREE. | 2698 | (when stn |
| 2276 | TREE is a section tree as returned by `rst-section-tree' | 2699 | (setq point (or point (point))) |
| 2277 | consisting of (NODE CHILD...) entries. POINT defaults to the | 2700 | (when (>= point (rst-Stn-get-title-beginning stn)) |
| 2278 | current point. A NODE must have the structure (IGNORED MARKER...). | 2701 | ;; Point may be in this section or a child. |
| 2279 | 2702 | (let ((children (rst-Stn-children stn)) | |
| 2280 | Return (PATH NODE CHILD...). NODE is the node where POINT is in | 2703 | found) |
| 2281 | if any. PATH is a list of nodes from the top of the tree down to | 2704 | (while (and children |
| 2282 | and including NODE. List of CHILD are the children of NODE if any." | 2705 | (>= point (rst-Stn-get-title-beginning (car children)))) |
| 2283 | (setq point (or point (point))) | 2706 | ;; Point may be in this child. |
| 2284 | (let ((cur (car tree)) | 2707 | (setq found (car children) |
| 2285 | (children (cdr tree))) | 2708 | children (cdr children))) |
| 2286 | ;; Point behind current node? | 2709 | (if found |
| 2287 | (if (and (cadr cur) (>= point (cadr cur))) | 2710 | (rst-stn-containing-point found point) |
| 2288 | ;; Iterate all the children, looking for one that might contain the | 2711 | stn))))) |
| 2289 | ;; current section. | ||
| 2290 | (let (found) | ||
| 2291 | (while (and children (>= point (cadaar children))) | ||
| 2292 | (setq found children | ||
| 2293 | children (cdr children))) | ||
| 2294 | (if found | ||
| 2295 | ;; Found section containing point in children. | ||
| 2296 | (let ((sub (rst-section-tree-point (car found) point))) | ||
| 2297 | ;; Extend path with current node and return NODE CHILD... from | ||
| 2298 | ;; sub. | ||
| 2299 | (cons (cons cur (car sub)) (cdr sub))) | ||
| 2300 | ;; Point in this section: Start a new path with current node and | ||
| 2301 | ;; return current NODE CHILD... | ||
| 2302 | (cons (list cur) tree))) | ||
| 2303 | ;; Current node behind point: start a new path with current node and | ||
| 2304 | ;; no NODE CHILD... | ||
| 2305 | (list (list cur))))) | ||
| 2306 | 2712 | ||
| 2307 | (defgroup rst-toc nil | 2713 | (defgroup rst-toc nil |
| 2308 | "Settings for reStructuredText table of contents." | 2714 | "Settings for reStructuredText table of contents." |
| @@ -2337,6 +2743,7 @@ indentation style: | |||
| 2337 | :group 'rst-toc) | 2743 | :group 'rst-toc) |
| 2338 | (rst-testcover-defcustom) | 2744 | (rst-testcover-defcustom) |
| 2339 | 2745 | ||
| 2746 | ;; FIXME: What does this mean? | ||
| 2340 | ;; This is used to avoid having to change the user's mode. | 2747 | ;; This is used to avoid having to change the user's mode. |
| 2341 | (defvar rst-toc-insert-click-keymap | 2748 | (defvar rst-toc-insert-click-keymap |
| 2342 | (let ((map (make-sparse-keymap))) | 2749 | (let ((map (make-sparse-keymap))) |
| @@ -2351,7 +2758,7 @@ indentation style: | |||
| 2351 | (rst-testcover-defcustom) | 2758 | (rst-testcover-defcustom) |
| 2352 | 2759 | ||
| 2353 | (defun rst-toc-insert (&optional pfxarg) | 2760 | (defun rst-toc-insert (&optional pfxarg) |
| 2354 | "Insert a simple text rendering of the table of contents. | 2761 | "Insert a text rendering of the table of contents of the current section. |
| 2355 | By default the top level is ignored if there is only one, because | 2762 | By default the top level is ignored if there is only one, because |
| 2356 | we assume that the document will have a single title. | 2763 | we assume that the document will have a single title. |
| 2357 | 2764 | ||
| @@ -2361,98 +2768,77 @@ to the specified level. | |||
| 2361 | The TOC is inserted indented at the current column." | 2768 | The TOC is inserted indented at the current column." |
| 2362 | (interactive "P") | 2769 | (interactive "P") |
| 2363 | (rst-reset-section-caches) | 2770 | (rst-reset-section-caches) |
| 2364 | (let* (;; Check maximum level override. | 2771 | (let (;; Check maximum level override. |
| 2365 | (rst-toc-insert-max-level | 2772 | (rst-toc-insert-max-level |
| 2366 | (if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0)) | 2773 | (if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0)) |
| 2367 | (prefix-numeric-value pfxarg) rst-toc-insert-max-level)) | 2774 | (prefix-numeric-value pfxarg) rst-toc-insert-max-level)) |
| 2368 | 2775 | (pt-stn (rst-stn-containing-point (rst-all-stn))) | |
| 2369 | ;; Get the section tree for the current cursor point. | 2776 | ;; Figure out initial indent. |
| 2370 | (sectree-pair | 2777 | (initial-indent (make-string (current-column) ? )) |
| 2371 | (rst-section-tree-point | 2778 | (init-point (point))) |
| 2372 | (rst-section-tree))) | 2779 | (when (and pt-stn (rst-Stn-children pt-stn)) |
| 2373 | 2780 | (rst-toc-insert-node pt-stn 0 initial-indent "") | |
| 2374 | ;; Figure out initial indent. | 2781 | ;; FIXME: Really having the last newline would be better. |
| 2375 | (initial-indent (make-string (current-column) ? )) | ||
| 2376 | (init-point (point))) | ||
| 2377 | |||
| 2378 | (when (cddr sectree-pair) | ||
| 2379 | (rst-toc-insert-node (cdr sectree-pair) 0 initial-indent "") | ||
| 2380 | |||
| 2381 | ;; Fixup for the first line. | ||
| 2382 | (delete-region init-point (+ init-point (length initial-indent))) | ||
| 2383 | |||
| 2384 | ;; Delete the last newline added. | 2782 | ;; Delete the last newline added. |
| 2385 | (delete-char -1)))) | 2783 | (delete-char -1)))) |
| 2386 | 2784 | ||
| 2387 | (defun rst-toc-insert-node (node level indent pfx) | 2785 | (defun rst-toc-insert-node (stn level indent pfx) |
| 2388 | "Insert tree node NODE in table-of-contents. | 2786 | "Insert STN in table-of-contents. |
| 2389 | Recursive function that does printing of the inserted TOC. | 2787 | LEVEL is the depth level of the sections in the tree currently |
| 2390 | LEVEL is the depth level of the sections in the tree. | 2788 | rendered. INDENT is the indentation string. PFX is the prefix |
| 2391 | INDENT is the indentation string. PFX is the prefix numbering, | 2789 | numbering, that includes the alignment necessary for all the |
| 2392 | that includes the alignment necessary for all the children of | 2790 | children of level to align." |
| 2393 | level to align." | ||
| 2394 | |||
| 2395 | ;; Note: we do child numbering from the parent, so we start number the | 2791 | ;; Note: we do child numbering from the parent, so we start number the |
| 2396 | ;; children one level before we print them. | 2792 | ;; children one level before we print them. |
| 2397 | (let ((do-print (> level 0)) | 2793 | (when (> level 0) |
| 2398 | (count 1)) | 2794 | (unless (> (current-column) 0) |
| 2399 | (when do-print | 2795 | ;; No indent yet - insert it. |
| 2400 | (insert indent) | 2796 | (insert indent)) |
| 2401 | (let ((b (point))) | 2797 | (let ((beg (point))) |
| 2402 | (unless (equal rst-toc-insert-style 'plain) | 2798 | (unless (equal rst-toc-insert-style 'plain) |
| 2403 | (insert pfx rst-toc-insert-number-separator)) | 2799 | (insert pfx rst-toc-insert-number-separator)) |
| 2404 | (insert (or (caar node) "[missing node]")) | 2800 | (insert (rst-Stn-get-text stn)) |
| 2405 | ;; Add properties to the text, even though in normal text mode it | 2801 | ;; Add properties to the text, even though in normal text mode it |
| 2406 | ;; won't be doing anything for now. Not sure that I want to change | 2802 | ;; won't be doing anything for now. Not sure that I want to change |
| 2407 | ;; mode stuff. At least the highlighting gives the idea that this | 2803 | ;; mode stuff. At least the highlighting gives the idea that this |
| 2408 | ;; is generated automatically. | 2804 | ;; is generated automatically. |
| 2409 | (put-text-property b (point) 'mouse-face 'highlight) | 2805 | (put-text-property beg (point) 'mouse-face 'highlight) |
| 2410 | (put-text-property b (point) 'rst-toc-target (cadar node)) | 2806 | (put-text-property |
| 2411 | (put-text-property b (point) 'keymap rst-toc-insert-click-keymap)) | 2807 | beg (point) 'rst-toc-target |
| 2412 | (insert "\n") | 2808 | (set-marker (make-marker) (rst-Stn-get-title-beginning stn))) |
| 2413 | 2809 | (put-text-property beg (point) 'keymap rst-toc-insert-click-keymap)) | |
| 2414 | ;; Prepare indent for children. | 2810 | (insert "\n") |
| 2415 | (setq indent | 2811 | ;; Prepare indent for children. |
| 2416 | (cond | 2812 | (setq indent |
| 2417 | ((eq rst-toc-insert-style 'plain) | 2813 | (cond |
| 2418 | (concat indent (make-string rst-toc-indent ? ))) | 2814 | ((eq rst-toc-insert-style 'plain) |
| 2419 | 2815 | (concat indent (make-string rst-toc-indent ? ))) | |
| 2420 | ((eq rst-toc-insert-style 'fixed) | 2816 | ((eq rst-toc-insert-style 'fixed) |
| 2421 | (concat indent (make-string rst-toc-indent ? ))) | 2817 | (concat indent (make-string rst-toc-indent ? ))) |
| 2422 | 2818 | ((eq rst-toc-insert-style 'aligned) | |
| 2423 | ((eq rst-toc-insert-style 'aligned) | 2819 | (concat indent (make-string (+ (length pfx) 2) ? ))) |
| 2424 | (concat indent (make-string (+ (length pfx) 2) ? ))) | 2820 | ((eq rst-toc-insert-style 'listed) |
| 2425 | 2821 | (concat (substring indent 0 -3) | |
| 2426 | ((eq rst-toc-insert-style 'listed) | 2822 | (concat (make-string (+ (length pfx) 2) ? ) " - ")))))) |
| 2427 | (concat (substring indent 0 -3) | 2823 | (when (or (eq rst-toc-insert-max-level nil) |
| 2428 | (concat (make-string (+ (length pfx) 2) ? ) " - ")))))) | 2824 | (< level rst-toc-insert-max-level)) |
| 2429 | 2825 | (let ((count 1) | |
| 2430 | (if (or (eq rst-toc-insert-max-level nil) | 2826 | fmt) |
| 2431 | (< level rst-toc-insert-max-level)) | 2827 | ;; Add a separating dot if there is already a prefix. |
| 2432 | (let ((do-child-numbering (>= level 0)) | 2828 | (when (> (length pfx) 0) |
| 2433 | fmt) | 2829 | (string-match (rst-re "[ \t\n]*\\'") pfx) |
| 2434 | (if do-child-numbering | 2830 | (setq pfx (concat (replace-match "" t t pfx) "."))) |
| 2435 | (progn | 2831 | ;; Calculate the amount of space that the prefix will require |
| 2436 | ;; Add a separating dot if there is already a prefix. | 2832 | ;; for the numbers. |
| 2437 | (when (> (length pfx) 0) | 2833 | (when (rst-Stn-children stn) |
| 2438 | (string-match (rst-re "[ \t\n]*\\'") pfx) | 2834 | (setq fmt |
| 2439 | (setq pfx (concat (replace-match "" t t pfx) "."))) | 2835 | (format "%%-%dd" |
| 2440 | 2836 | (1+ (floor (log (length (rst-Stn-children stn)) | |
| 2441 | ;; Calculate the amount of space that the prefix will require | 2837 | 10)))))) |
| 2442 | ;; for the numbers. | 2838 | (dolist (child (rst-Stn-children stn)) |
| 2443 | (if (cdr node) | 2839 | (rst-toc-insert-node child (1+ level) indent |
| 2444 | (setq fmt (format "%%-%dd" | 2840 | (concat pfx (format fmt count))) |
| 2445 | (1+ (floor (log (length (cdr node)) | 2841 | (incf count))))) |
| 2446 | 10)))))))) | ||
| 2447 | |||
| 2448 | (dolist (child (cdr node)) | ||
| 2449 | (rst-toc-insert-node child | ||
| 2450 | (1+ level) | ||
| 2451 | indent | ||
| 2452 | (if do-child-numbering | ||
| 2453 | (concat pfx (format fmt count)) pfx)) | ||
| 2454 | (incf count)))))) | ||
| 2455 | |||
| 2456 | 2842 | ||
| 2457 | (defun rst-toc-update () | 2843 | (defun rst-toc-update () |
| 2458 | "Automatically find the contents section of a document and update. | 2844 | "Automatically find the contents section of a document and update. |
| @@ -2497,57 +2883,45 @@ file-write hook to always make it up-to-date automatically." | |||
| 2497 | ;; Note: always return nil, because this may be used as a hook. | 2883 | ;; Note: always return nil, because this may be used as a hook. |
| 2498 | nil) | 2884 | nil) |
| 2499 | 2885 | ||
| 2500 | ;; Note: we cannot bind the TOC update on file write because it messes with | 2886 | ;; FIXME: Updating the toc on saving would be nice. However, this doesn't work |
| 2501 | ;; undo. If we disable undo, since it adds and removes characters, the | 2887 | ;; correctly: |
| 2502 | ;; positions in the undo list are not making sense anymore. Dunno what to do | ||
| 2503 | ;; with this, it would be nice to update when saving. | ||
| 2504 | ;; | 2888 | ;; |
| 2505 | ;; (add-hook 'write-contents-hooks 'rst-toc-update-fun) | 2889 | ;; (add-hook 'write-contents-hooks 'rst-toc-update-fun) |
| 2506 | ;; (defun rst-toc-update-fun () | 2890 | ;; (defun rst-toc-update-fun () |
| 2507 | ;; ;; Disable undo for the write file hook. | 2891 | ;; ;; Disable undo for the write file hook. |
| 2508 | ;; (let ((buffer-undo-list t)) (rst-toc-update) )) | 2892 | ;; (let ((buffer-undo-list t)) (rst-toc-update) )) |
| 2509 | 2893 | ||
| 2510 | (defalias 'rst-toc-insert-update 'rst-toc-update) ; backwards compat. | 2894 | (defalias 'rst-toc-insert-update 'rst-toc-update) ; backwards compat. |
| 2511 | 2895 | ||
| 2512 | ;;------------------------------------------------------------------------------ | 2896 | (defun rst-toc-node (stn buf target) |
| 2513 | 2897 | "Insert STN in the table-of-contents of buffer BUF. | |
| 2514 | (defun rst-toc-node (node level) | 2898 | If TARGET is given and this call renders a `rst-Stn' at the same |
| 2515 | "Recursive function that does insert NODE at LEVEL in the table-of-contents." | 2899 | location return position of beginning of line. Otherwise return |
| 2516 | 2900 | nil." | |
| 2517 | (if (> level 0) | 2901 | (let ((beg (point)) |
| 2518 | (let ((b (point))) | 2902 | fnd) |
| 2519 | ;; Insert line text. | 2903 | (if (or (not stn) (rst-Stn-is-top stn)) |
| 2520 | (insert (make-string (* rst-toc-indent (1- level)) ? )) | 2904 | (progn |
| 2521 | (insert (or (caar node) "[missing node]")) | 2905 | (insert (format "Table of Contents:\n")) |
| 2522 | 2906 | (put-text-property beg (point) | |
| 2523 | ;; Highlight lines. | 2907 | 'face (list '(background-color . "gray")))) |
| 2524 | (put-text-property b (point) 'mouse-face 'highlight) | 2908 | (when (and target |
| 2525 | 2909 | (equal (rst-Stn-get-title-beginning stn) | |
| 2526 | ;; Add link on lines. | 2910 | (rst-Stn-get-title-beginning target))) |
| 2527 | (put-text-property b (point) 'rst-toc-target (cadar node)) | 2911 | (setq fnd beg)) |
| 2528 | 2912 | (insert (make-string (* rst-toc-indent (rst-Stn-level stn)) ? )) | |
| 2529 | (insert "\n"))) | 2913 | (insert (rst-Stn-get-text stn)) |
| 2530 | 2914 | ;; Highlight lines. | |
| 2531 | (dolist (child (cdr node)) | 2915 | (put-text-property beg (point) 'mouse-face 'highlight) |
| 2532 | (rst-toc-node child (1+ level)))) | 2916 | (insert "\n") |
| 2533 | 2917 | ;; Add link on lines. | |
| 2534 | (defun rst-toc-count-lines (node target-node) | 2918 | (put-text-property |
| 2535 | "Count the number of lines from NODE to the TARGET-NODE node. | 2919 | beg (point) 'rst-toc-target |
| 2536 | This recursive function returns a cons of the number of | 2920 | (set-marker (make-marker) (rst-Stn-get-title-beginning stn) buf))) |
| 2537 | additional lines that have been counted for its node and | 2921 | (when stn |
| 2538 | children, and t if the node has been found." | 2922 | (dolist (child (rst-Stn-children stn)) |
| 2539 | 2923 | (setq fnd (or (rst-toc-node child buf target) fnd)))) | |
| 2540 | (let ((count 1) | 2924 | fnd)) |
| 2541 | found) | ||
| 2542 | (if (eq node target-node) | ||
| 2543 | (setq found t) | ||
| 2544 | (let ((child (cdr node))) | ||
| 2545 | (while (and child (not found)) | ||
| 2546 | (let ((cl (rst-toc-count-lines (car child) target-node))) | ||
| 2547 | (setq count (+ count (car cl)) | ||
| 2548 | found (cdr cl) | ||
| 2549 | child (cdr child)))))) | ||
| 2550 | (cons count found))) | ||
| 2551 | 2925 | ||
| 2552 | (defvar rst-toc-buffer-name "*Table of Contents*" | 2926 | (defvar rst-toc-buffer-name "*Table of Contents*" |
| 2553 | "Name of the Table of Contents buffer.") | 2927 | "Name of the Table of Contents buffer.") |
| @@ -2555,7 +2929,6 @@ children, and t if the node has been found." | |||
| 2555 | (defvar rst-toc-return-wincfg nil | 2929 | (defvar rst-toc-return-wincfg nil |
| 2556 | "Window configuration to which to return when leaving the TOC.") | 2930 | "Window configuration to which to return when leaving the TOC.") |
| 2557 | 2931 | ||
| 2558 | |||
| 2559 | (defun rst-toc () | 2932 | (defun rst-toc () |
| 2560 | "Display a table-of-contents. | 2933 | "Display a table-of-contents. |
| 2561 | Finds all the section titles and their adornments in the | 2934 | Finds all the section titles and their adornments in the |
| @@ -2567,37 +2940,21 @@ The Emacs buffer can be navigated, and selecting a section | |||
| 2567 | brings the cursor in that section." | 2940 | brings the cursor in that section." |
| 2568 | (interactive) | 2941 | (interactive) |
| 2569 | (rst-reset-section-caches) | 2942 | (rst-reset-section-caches) |
| 2570 | (let* ((curbuf (list (current-window-configuration) (point-marker))) | 2943 | (let* ((wincfg (list (current-window-configuration) (point-marker))) |
| 2571 | (sectree (rst-section-tree)) | 2944 | (sectree (rst-all-stn)) |
| 2572 | 2945 | (target-node (rst-stn-containing-point sectree)) | |
| 2573 | (our-node (cdr (rst-section-tree-point sectree))) | 2946 | (target-buf (current-buffer)) |
| 2574 | line | 2947 | (buf (get-buffer-create rst-toc-buffer-name)) |
| 2575 | 2948 | target-pos) | |
| 2576 | ;; Create a temporary buffer. | ||
| 2577 | (buf (get-buffer-create rst-toc-buffer-name))) | ||
| 2578 | |||
| 2579 | (with-current-buffer buf | 2949 | (with-current-buffer buf |
| 2580 | (let ((inhibit-read-only t)) | 2950 | (let ((inhibit-read-only t)) |
| 2581 | (rst-toc-mode) | 2951 | (rst-toc-mode) |
| 2582 | (delete-region (point-min) (point-max)) | 2952 | (delete-region (point-min) (point-max)) |
| 2583 | (insert (format "Table of Contents: %s\n" (or (caar sectree) ""))) | 2953 | (setq target-pos (rst-toc-node sectree target-buf target-node)))) |
| 2584 | (put-text-property (point-min) (point) | ||
| 2585 | 'face (list '(background-color . "gray"))) | ||
| 2586 | (rst-toc-node sectree 0) | ||
| 2587 | |||
| 2588 | ;; Count the lines to our found node. | ||
| 2589 | (let ((linefound (rst-toc-count-lines sectree our-node))) | ||
| 2590 | (setq line (if (cdr linefound) (car linefound) 0))))) | ||
| 2591 | (display-buffer buf) | 2954 | (display-buffer buf) |
| 2592 | (pop-to-buffer buf) | 2955 | (pop-to-buffer buf) |
| 2593 | 2956 | (setq-local rst-toc-return-wincfg wincfg) | |
| 2594 | ;; Save the buffer to return to. | 2957 | (goto-char (or target-pos (point-min))))) |
| 2595 | (set (make-local-variable 'rst-toc-return-wincfg) curbuf) | ||
| 2596 | |||
| 2597 | ;; Move the cursor near the right section in the TOC. | ||
| 2598 | (goto-char (point-min)) | ||
| 2599 | (forward-line (1- line)))) | ||
| 2600 | |||
| 2601 | 2958 | ||
| 2602 | (defun rst-toc-mode-find-section () | 2959 | (defun rst-toc-mode-find-section () |
| 2603 | "Get the section from text property at point." | 2960 | "Get the section from text property at point." |
| @@ -2660,10 +3017,12 @@ EVENT is the input event." | |||
| 2660 | (defvar rst-toc-mode-map | 3017 | (defvar rst-toc-mode-map |
| 2661 | (let ((map (make-sparse-keymap))) | 3018 | (let ((map (make-sparse-keymap))) |
| 2662 | (define-key map [mouse-1] 'rst-toc-mode-mouse-goto-kill) | 3019 | (define-key map [mouse-1] 'rst-toc-mode-mouse-goto-kill) |
| 3020 | ;; FIXME: This very useful function must be on some key. | ||
| 2663 | (define-key map [mouse-2] 'rst-toc-mode-mouse-goto) | 3021 | (define-key map [mouse-2] 'rst-toc-mode-mouse-goto) |
| 2664 | (define-key map "\C-m" 'rst-toc-mode-goto-section) | 3022 | (define-key map "\C-m" 'rst-toc-mode-goto-section) |
| 2665 | (define-key map "f" 'rst-toc-mode-goto-section) | 3023 | (define-key map "f" 'rst-toc-mode-goto-section) |
| 2666 | (define-key map "q" 'rst-toc-quit-window) | 3024 | (define-key map "q" 'rst-toc-quit-window) |
| 3025 | ;; FIXME: Killing should clean up like `rst-toc-quit-window' does. | ||
| 2667 | (define-key map "z" 'kill-this-buffer) | 3026 | (define-key map "z" 'kill-this-buffer) |
| 2668 | map) | 3027 | map) |
| 2669 | "Keymap for `rst-toc-mode'.") | 3028 | "Keymap for `rst-toc-mode'.") |
| @@ -2672,15 +3031,13 @@ EVENT is the input event." | |||
| 2672 | 3031 | ||
| 2673 | ;; Could inherit from the new `special-mode'. | 3032 | ;; Could inherit from the new `special-mode'. |
| 2674 | (define-derived-mode rst-toc-mode nil "ReST-TOC" | 3033 | (define-derived-mode rst-toc-mode nil "ReST-TOC" |
| 2675 | "Major mode for output from \\[rst-toc], the table-of-contents for the document." | 3034 | "Major mode for output from \\[rst-toc], the table-of-contents for the document. |
| 2676 | (setq buffer-read-only t)) | ||
| 2677 | 3035 | ||
| 2678 | ;; Note: use occur-mode (replace.el) as a good example to complete missing | 3036 | \\{rst-toc-mode-map}" |
| 2679 | ;; features. | 3037 | (setq buffer-read-only t)) |
| 2680 | 3038 | ||
| 2681 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 3039 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2682 | ;; Section movement commands | 3040 | ;; Section movement |
| 2683 | ;; ========================= | ||
| 2684 | 3041 | ||
| 2685 | (defun rst-forward-section (&optional offset) | 3042 | (defun rst-forward-section (&optional offset) |
| 2686 | "Skip to the next reStructuredText section title. | 3043 | "Skip to the next reStructuredText section title. |
| @@ -2688,38 +3045,32 @@ OFFSET specifies how many titles to skip. Use a negative OFFSET | |||
| 2688 | to move backwards in the file (default is to use 1)." | 3045 | to move backwards in the file (default is to use 1)." |
| 2689 | (interactive) | 3046 | (interactive) |
| 2690 | (rst-reset-section-caches) | 3047 | (rst-reset-section-caches) |
| 2691 | (let* (;; Default value for offset. | 3048 | (let* ((offset (or offset 1)) |
| 2692 | (offset (or offset 1)) | 3049 | (ttls (rst-all-ttls)) |
| 2693 | 3050 | (curpos (line-beginning-position)) | |
| 2694 | ;; Get all the adornments in the file, with their line numbers. | 3051 | (cur ttls) |
| 2695 | (allados (rst-find-all-adornments)) | 3052 | (idx 0) |
| 2696 | 3053 | ttl) | |
| 2697 | ;; Get the current line. | 3054 | |
| 2698 | (curline (line-number-at-pos)) | 3055 | ;; Find the index of the "next" adornment with respect to the current line. |
| 2699 | 3056 | (while (and cur (< (rst-Ttl-get-title-beginning (car cur)) curpos)) | |
| 2700 | (cur allados) | ||
| 2701 | (idx 0)) | ||
| 2702 | |||
| 2703 | ;; Find the index of the "next" adornment w.r.t. to the current line. | ||
| 2704 | (while (and cur (< (caar cur) curline)) | ||
| 2705 | (setq cur (cdr cur)) | 3057 | (setq cur (cdr cur)) |
| 2706 | (incf idx)) | 3058 | (incf idx)) |
| 2707 | ;; 'cur' is the adornment on or following the current line. | 3059 | ;; `cur' is the `rst-Ttl' on or following the current line. |
| 2708 | 3060 | ||
| 2709 | (if (and (> offset 0) cur (= (caar cur) curline)) | 3061 | (if (and (> offset 0) cur |
| 3062 | (equal (rst-Ttl-get-title-beginning (car cur)) curpos)) | ||
| 2710 | (incf idx)) | 3063 | (incf idx)) |
| 2711 | 3064 | ||
| 2712 | ;; Find the final index. | 3065 | ;; Find the final index. |
| 2713 | (setq idx (+ idx (if (> offset 0) (- offset 1) offset))) | 3066 | (setq idx (+ idx (if (> offset 0) (- offset 1) offset))) |
| 2714 | (setq cur (nth idx allados)) | 3067 | (setq ttl (nth idx ttls)) |
| 2715 | 3068 | (goto-char (cond | |
| 2716 | ;; If the index is positive, goto the line, otherwise go to the buffer | 3069 | ((and ttl (>= idx 0)) |
| 2717 | ;; boundaries. | 3070 | (rst-Ttl-get-title-beginning ttl)) |
| 2718 | (if (and cur (>= idx 0)) | 3071 | ((> offset 0) |
| 2719 | (progn | 3072 | (point-max)) |
| 2720 | (goto-char (point-min)) | 3073 | ((point-min)))))) |
| 2721 | (forward-line (1- (car cur)))) | ||
| 2722 | (if (> offset 0) (goto-char (point-max)) (goto-char (point-min)))))) | ||
| 2723 | 3074 | ||
| 2724 | (defun rst-backward-section () | 3075 | (defun rst-backward-section () |
| 2725 | "Like `rst-forward-section', except move back one title." | 3076 | "Like `rst-forward-section', except move back one title." |
| @@ -2751,11 +3102,13 @@ for negative COUNT." | |||
| 2751 | 3102 | ||
| 2752 | 3103 | ||
| 2753 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 3104 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2754 | ;; Functions to work on item lists (e.g. indent/dedent, enumerate), which are | 3105 | ;; Indentation |
| 2755 | ;; always 2 or 3 characters apart horizontally with rest. | ||
| 2756 | 3106 | ||
| 2757 | (defun rst-find-leftmost-column (beg end) | 3107 | (defun rst-find-leftmost-column (beg end) |
| 2758 | "Return the leftmost column in region BEG to END." | 3108 | "Return the leftmost column spanned by region BEG to END. |
| 3109 | The line containing the start of the region is always considered | ||
| 3110 | spanned. If the region ends at the beginning of a line this line | ||
| 3111 | is not considered spanned, otherwise it is spanned." | ||
| 2759 | (let (mincol) | 3112 | (let (mincol) |
| 2760 | (save-excursion | 3113 | (save-excursion |
| 2761 | (goto-char beg) | 3114 | (goto-char beg) |
| @@ -2768,80 +3121,6 @@ for negative COUNT." | |||
| 2768 | (forward-line 1))) | 3121 | (forward-line 1))) |
| 2769 | mincol)) | 3122 | mincol)) |
| 2770 | 3123 | ||
| 2771 | ;; FIXME: This definition is old and deprecated. We need to move to the newer | ||
| 2772 | ;; version below. | ||
| 2773 | (defmacro rst-iterate-leftmost-paragraphs | ||
| 2774 | (beg end first-only body-consequent body-alternative) | ||
| 2775 | ;; FIXME: The following comment is pretty useless. | ||
| 2776 | "Call FUN at the beginning of each line, with an argument that | ||
| 2777 | specifies whether we are at the first line of a paragraph that | ||
| 2778 | starts at the leftmost column of the given region BEG and END. | ||
| 2779 | Set FIRST-ONLY to true if you want to callback on the first line | ||
| 2780 | of each paragraph only." | ||
| 2781 | `(save-excursion | ||
| 2782 | (let ((leftcol (rst-find-leftmost-column ,beg ,end)) | ||
| 2783 | (endm (copy-marker ,end))) | ||
| 2784 | |||
| 2785 | (do* (;; Iterate lines. | ||
| 2786 | (l (progn (goto-char ,beg) (back-to-indentation)) | ||
| 2787 | (progn (forward-line 1) (back-to-indentation))) | ||
| 2788 | |||
| 2789 | (previous nil valid) | ||
| 2790 | |||
| 2791 | (curcol (current-column) | ||
| 2792 | (current-column)) | ||
| 2793 | |||
| 2794 | (valid (and (= curcol leftcol) | ||
| 2795 | (not (looking-at (rst-re 'lin-end)))) | ||
| 2796 | (and (= curcol leftcol) | ||
| 2797 | (not (looking-at (rst-re 'lin-end)))))) | ||
| 2798 | ((>= (point) endm)) | ||
| 2799 | |||
| 2800 | (if (if ,first-only | ||
| 2801 | (and valid (not previous)) | ||
| 2802 | valid) | ||
| 2803 | ,body-consequent | ||
| 2804 | ,body-alternative))))) | ||
| 2805 | |||
| 2806 | ;; FIXME: This needs to be refactored. Probably this is simply a function | ||
| 2807 | ;; applying BODY rather than a macro. | ||
| 2808 | (defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body) | ||
| 2809 | "Evaluate BODY for each line in region defined by BEG END. | ||
| 2810 | LEFTMOST is set to true if the line is one of the leftmost of the | ||
| 2811 | entire paragraph. PARABEGIN is set to true if the line is the | ||
| 2812 | first of a paragraph." | ||
| 2813 | (declare (indent 1) (debug (sexp body))) | ||
| 2814 | (destructuring-bind | ||
| 2815 | (beg end parabegin leftmost isleftmost isempty) spec | ||
| 2816 | |||
| 2817 | `(save-excursion | ||
| 2818 | (let ((,leftmost (rst-find-leftmost-column ,beg ,end)) | ||
| 2819 | (endm (copy-marker ,end))) | ||
| 2820 | |||
| 2821 | (do* (;; Iterate lines. | ||
| 2822 | (l (progn (goto-char ,beg) (back-to-indentation)) | ||
| 2823 | (progn (forward-line 1) (back-to-indentation))) | ||
| 2824 | |||
| 2825 | (empty-line-previous nil ,isempty) | ||
| 2826 | |||
| 2827 | (,isempty (looking-at (rst-re 'lin-end)) | ||
| 2828 | (looking-at (rst-re 'lin-end))) | ||
| 2829 | |||
| 2830 | (,parabegin (not ,isempty) | ||
| 2831 | (and empty-line-previous | ||
| 2832 | (not ,isempty))) | ||
| 2833 | |||
| 2834 | (,isleftmost (and (not ,isempty) | ||
| 2835 | (= (current-column) ,leftmost)) | ||
| 2836 | (and (not ,isempty) | ||
| 2837 | (= (current-column) ,leftmost)))) | ||
| 2838 | ((>= (point) endm)) | ||
| 2839 | |||
| 2840 | (progn ,@body)))))) | ||
| 2841 | |||
| 2842 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 2843 | ;; Indentation | ||
| 2844 | |||
| 2845 | ;; FIXME: At the moment only block comments with leading empty comment line are | 3124 | ;; FIXME: At the moment only block comments with leading empty comment line are |
| 2846 | ;; supported. Comment lines with leading comment markup should be also | 3125 | ;; supported. Comment lines with leading comment markup should be also |
| 2847 | ;; supported. May be a customizable option could control which style to | 3126 | ;; supported. May be a customizable option could control which style to |
| @@ -3052,7 +3331,7 @@ above. If no suitable tab is found `rst-indent-width' is used." | |||
| 3052 | (abs (abs cnt)) ; Absolute number of steps to take. | 3331 | (abs (abs cnt)) ; Absolute number of steps to take. |
| 3053 | ;; Get the position of the first tab beyond leftmostcol. | 3332 | ;; Get the position of the first tab beyond leftmostcol. |
| 3054 | (fnd (lexical-let ((cmp cmp) | 3333 | (fnd (lexical-let ((cmp cmp) |
| 3055 | (leftmostcol leftmostcol)) ; Create closure. | 3334 | (leftmostcol leftmostcol)) ;; Create closure. |
| 3056 | (rst-position-if (lambda (elt) | 3335 | (rst-position-if (lambda (elt) |
| 3057 | (funcall cmp elt leftmostcol)) | 3336 | (funcall cmp elt leftmostcol)) |
| 3058 | tabs))) | 3337 | tabs))) |
| @@ -3139,7 +3418,7 @@ Region is from BEG to END. Uncomment if ARG." | |||
| 3139 | 3418 | ||
| 3140 | (defun rst-uncomment-region (beg end &optional _arg) | 3419 | (defun rst-uncomment-region (beg end &optional _arg) |
| 3141 | "Uncomment the current region. | 3420 | "Uncomment the current region. |
| 3142 | Region is from BEG to END. ARG is ignored" | 3421 | Region is from BEG to END. _ARG is ignored" |
| 3143 | (save-excursion | 3422 | (save-excursion |
| 3144 | (let (bol eol) | 3423 | (let (bol eol) |
| 3145 | (goto-char beg) | 3424 | (goto-char beg) |
| @@ -3150,7 +3429,8 @@ Region is from BEG to END. ARG is ignored" | |||
| 3150 | (indent-rigidly eol end (- rst-indent-comment)) | 3429 | (indent-rigidly eol end (- rst-indent-comment)) |
| 3151 | (delete-region bol eol)))) | 3430 | (delete-region bol eol)))) |
| 3152 | 3431 | ||
| 3153 | ;;------------------------------------------------------------------------------ | 3432 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3433 | ;; Apply to indented block | ||
| 3154 | 3434 | ||
| 3155 | ;; FIXME: These next functions should become part of a larger effort to redo | 3435 | ;; FIXME: These next functions should become part of a larger effort to redo |
| 3156 | ;; the bullets in bulleted lists. The enumerate would just be one of | 3436 | ;; the bullets in bulleted lists. The enumerate would just be one of |
| @@ -3158,29 +3438,127 @@ Region is from BEG to END. ARG is ignored" | |||
| 3158 | ;; | 3438 | ;; |
| 3159 | ;; FIXME: We need to do the enumeration removal as well. | 3439 | ;; FIXME: We need to do the enumeration removal as well. |
| 3160 | 3440 | ||
| 3441 | (defun rst-apply-indented-blocks (beg end ind fun) | ||
| 3442 | "Apply FUN to all lines from BEG to END in blocks indented to IND. | ||
| 3443 | The first indented block starts with the first non-empty line | ||
| 3444 | containing or after BEG and indented to IND. After the first | ||
| 3445 | line the indented block may contain more lines with same | ||
| 3446 | indentation (the paragraph) followed by empty lines and lines | ||
| 3447 | more indented (the sub-blocks). A following line indented to IND | ||
| 3448 | starts the next indented block. A line with less indentation | ||
| 3449 | than IND terminates the current indented block. Such lines and | ||
| 3450 | all following lines not indented to IND are skipped. FUN is | ||
| 3451 | applied to unskipped lines like this | ||
| 3452 | |||
| 3453 | (FUN COUNT FIRSTP SUBP EMPTYP RELIND LASTRET) | ||
| 3454 | |||
| 3455 | COUNT is 0 before the first indented block and increments for | ||
| 3456 | every indented block found. | ||
| 3457 | |||
| 3458 | FIRSTP is t when this is the first line of the paragraph. | ||
| 3459 | |||
| 3460 | SUBP is t when this line is part of a sub-block. | ||
| 3461 | |||
| 3462 | EMPTYP is t when this line is empty. | ||
| 3463 | |||
| 3464 | RELIND is nil for an empty line, 0 for a line indented to IND, | ||
| 3465 | and the number of columns more indented otherwise. | ||
| 3466 | |||
| 3467 | LASTRET is the return value of FUN returned by the last | ||
| 3468 | invocation for the same indented block or nil for the first | ||
| 3469 | invocation. | ||
| 3470 | |||
| 3471 | When FUN is called point is immediately behind indentation of | ||
| 3472 | that line. FUN may change everything as long as a marker at END | ||
| 3473 | is handled correctly by the change. | ||
| 3474 | |||
| 3475 | Return the return value of the last invocation of FUN or nil if | ||
| 3476 | FUN was never called." | ||
| 3477 | (let (lastret | ||
| 3478 | subp | ||
| 3479 | skipping | ||
| 3480 | nextm | ||
| 3481 | (count 0) ; Before first indented block | ||
| 3482 | (endm (copy-marker end t))) | ||
| 3483 | (save-excursion | ||
| 3484 | (goto-char beg) | ||
| 3485 | (while (< (point) endm) | ||
| 3486 | (save-excursion | ||
| 3487 | (setq nextm (save-excursion | ||
| 3488 | (forward-line 1) | ||
| 3489 | (copy-marker (point) t))) | ||
| 3490 | (back-to-indentation) | ||
| 3491 | (let (firstp | ||
| 3492 | emptyp | ||
| 3493 | (relind (- (current-column) ind))) | ||
| 3494 | (cond | ||
| 3495 | ((looking-at (rst-re 'lin-end)) | ||
| 3496 | (setq emptyp t) | ||
| 3497 | (setq relind nil) | ||
| 3498 | ;; Breaks indented block if one is started | ||
| 3499 | (setq subp (not (zerop count)))) | ||
| 3500 | ((< relind 0) ; Less indented | ||
| 3501 | (setq skipping t)) | ||
| 3502 | ((zerop relind) ; In indented block | ||
| 3503 | (when (or subp skipping (zerop count)) | ||
| 3504 | (setq firstp t) | ||
| 3505 | (incf count)) | ||
| 3506 | (setq subp nil) | ||
| 3507 | (setq skipping nil)) | ||
| 3508 | (t ; More indented | ||
| 3509 | (setq subp t))) | ||
| 3510 | (unless skipping | ||
| 3511 | (setq lastret | ||
| 3512 | (funcall fun count firstp subp emptyp relind lastret))))) | ||
| 3513 | (goto-char nextm)) | ||
| 3514 | lastret))) | ||
| 3515 | |||
| 3161 | (defun rst-enumerate-region (beg end all) | 3516 | (defun rst-enumerate-region (beg end all) |
| 3162 | "Add enumeration to all the leftmost paragraphs in the given region. | 3517 | "Add enumeration to all the leftmost paragraphs in the given region. |
| 3163 | The region is specified between BEG and END. With ALL, | 3518 | The region is specified between BEG and END. With ALL, |
| 3164 | do all lines instead of just paragraphs." | 3519 | do all lines instead of just paragraphs." |
| 3165 | (interactive "r\nP") | 3520 | (interactive "r\nP") |
| 3166 | (let ((count 0) | 3521 | (let ((enum 0)) |
| 3167 | (last-insert-len nil)) | 3522 | (rst-apply-indented-blocks |
| 3168 | (rst-iterate-leftmost-paragraphs | 3523 | beg end (rst-find-leftmost-column beg end) |
| 3169 | beg end (not all) | 3524 | (lambda (count firstp subp emptyp relind lastret) |
| 3170 | (let ((ins-string (format "%d. " (incf count)))) | 3525 | (cond |
| 3171 | (setq last-insert-len (length ins-string)) | 3526 | (emptyp) |
| 3172 | (insert ins-string)) | 3527 | ((zerop count)) |
| 3173 | (insert (make-string last-insert-len ?\ ))))) | 3528 | (subp |
| 3529 | (insert lastret)) | ||
| 3530 | ((or firstp all) | ||
| 3531 | (let ((ins (format "%d. " (incf enum)))) | ||
| 3532 | (setq lastret (make-string (length ins) ?\ )) | ||
| 3533 | (insert ins))) | ||
| 3534 | (t | ||
| 3535 | (insert lastret))) | ||
| 3536 | lastret)))) | ||
| 3174 | 3537 | ||
| 3538 | ;; FIXME: Does not deal with deeper indentation - although | ||
| 3539 | ;; `rst-apply-indented-blocks' could. | ||
| 3175 | (defun rst-bullet-list-region (beg end all) | 3540 | (defun rst-bullet-list-region (beg end all) |
| 3176 | "Add bullets to all the leftmost paragraphs in the given region. | 3541 | "Add bullets to all the leftmost paragraphs in the given region. |
| 3177 | The region is specified between BEG and END. With ALL, | 3542 | The region is specified between BEG and END. With ALL, |
| 3178 | do all lines instead of just paragraphs." | 3543 | do all lines instead of just paragraphs." |
| 3179 | (interactive "r\nP") | 3544 | (interactive "r\nP") |
| 3180 | (rst-iterate-leftmost-paragraphs | 3545 | (unless rst-preferred-bullets |
| 3181 | beg end (not all) | 3546 | (error "No preferred bullets defined")) |
| 3182 | (insert (car rst-preferred-bullets) " ") | 3547 | (let ((bul (format "%c " (car rst-preferred-bullets))) |
| 3183 | (insert " "))) | 3548 | (cont " ")) |
| 3549 | (rst-apply-indented-blocks | ||
| 3550 | beg end (rst-find-leftmost-column beg end) | ||
| 3551 | (lambda (count firstp subp emptyp relind lastret) | ||
| 3552 | (cond | ||
| 3553 | (emptyp) | ||
| 3554 | ((zerop count)) | ||
| 3555 | (subp | ||
| 3556 | (insert cont)) | ||
| 3557 | ((or firstp all) | ||
| 3558 | (insert bul)) | ||
| 3559 | (t | ||
| 3560 | (insert cont))) | ||
| 3561 | nil)))) | ||
| 3184 | 3562 | ||
| 3185 | ;; FIXME: Does not deal with a varying number of digits appropriately. | 3563 | ;; FIXME: Does not deal with a varying number of digits appropriately. |
| 3186 | ;; FIXME: Does not deal with multiple levels independently. | 3564 | ;; FIXME: Does not deal with multiple levels independently. |
| @@ -3203,29 +3581,21 @@ Renumber as necessary. Region is from BEG to END." | |||
| 3203 | (replace-match (format "%d." count) nil nil nil 1) | 3581 | (replace-match (format "%d." count) nil nil nil 1) |
| 3204 | (incf count))))) | 3582 | (incf count))))) |
| 3205 | 3583 | ||
| 3206 | ;;------------------------------------------------------------------------------ | 3584 | (defun rst-line-block-region (beg end &optional with-empty) |
| 3207 | 3585 | "Add line block prefixes for a region. | |
| 3208 | (defun rst-line-block-region (rbeg rend &optional pfxarg) | 3586 | Region is from BEG to END. With WITH-EMPTY prefix empty lines too." |
| 3209 | "Toggle line block prefixes for a region. | ||
| 3210 | Region is from RBEG to REND. With PFXARG set the empty lines too." | ||
| 3211 | (interactive "r\nP") | 3587 | (interactive "r\nP") |
| 3212 | (let ((comment-start "| ") | 3588 | (let ((ind (rst-find-leftmost-column beg end))) |
| 3213 | (comment-end "") | 3589 | (rst-apply-indented-blocks |
| 3214 | (comment-start-skip "| ") | 3590 | beg end ind |
| 3215 | (comment-style 'indent) | 3591 | (lambda (count firstp subp emptyp relind lastret) |
| 3216 | (force (not (not pfxarg)))) | 3592 | (when (or with-empty (not emptyp)) |
| 3217 | (rst-iterate-leftmost-paragraphs-2 | 3593 | (move-to-column ind t) |
| 3218 | (rbeg rend parbegin leftmost isleft isempty) | 3594 | (insert "| ")))))) |
| 3219 | (when (or force (not isempty)) | ||
| 3220 | (move-to-column leftmost force) | ||
| 3221 | (delete-region (point) (+ (point) (- (current-indentation) leftmost))) | ||
| 3222 | (insert "| "))))) | ||
| 3223 | |||
| 3224 | 3595 | ||
| 3225 | 3596 | ||
| 3226 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 3597 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3227 | ;; Font lock | 3598 | ;; Font lock |
| 3228 | ;; ========= | ||
| 3229 | 3599 | ||
| 3230 | (require 'font-lock) | 3600 | (require 'font-lock) |
| 3231 | 3601 | ||
| @@ -3525,7 +3895,7 @@ of your own." | |||
| 3525 | (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx) | 3895 | (,(rst-re 'ilm-pfx '(:grp "_`" ilcbkq-tag "`") 'ilm-sfx) |
| 3526 | 1 rst-definition-face) | 3896 | 1 rst-definition-face) |
| 3527 | ;; `Hyperlink References`_ | 3897 | ;; `Hyperlink References`_ |
| 3528 | ;; FIXME: `Embedded URIs`_ not considered. | 3898 | ;; FIXME: `Embedded URIs and Aliases`_ not considered. |
| 3529 | ;; FIXME: Directly adjacent marked up words are not fontified correctly | 3899 | ;; FIXME: Directly adjacent marked up words are not fontified correctly |
| 3530 | ;; unless they are not separated by two spaces: foo_ bar_. | 3900 | ;; unless they are not separated by two spaces: foo_ bar_. |
| 3531 | (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`") | 3901 | (,(rst-re 'ilm-pfx '(:grp (:alt (:seq "`" ilcbkq-tag "`") |
| @@ -3714,9 +4084,9 @@ Return extended point or nil if not moved." | |||
| 3714 | (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline / | 4084 | (if (looking-at (rst-re 'ado-beg-2-1)) ; may be an underline / |
| 3715 | ; overline. | 4085 | ; overline. |
| 3716 | (if (zerop (rst-forward-line dir)) | 4086 | (if (zerop (rst-forward-line dir)) |
| 3717 | (if (looking-at (rst-re 'ttl-beg)) ; title found, i.e. | 4087 | (if (looking-at (rst-re 'ttl-beg-1)) ; title found, i.e. |
| 3718 | ; underline / overline | 4088 | ; underline / overline |
| 3719 | ; found. | 4089 | ; found. |
| 3720 | (if (zerop (rst-forward-line dir)) | 4090 | (if (zerop (rst-forward-line dir)) |
| 3721 | (if (not | 4091 | (if (not |
| 3722 | (looking-at (rst-re 'ado-beg-2-1))) ; no | 4092 | (looking-at (rst-re 'ado-beg-2-1))) ; no |
| @@ -3726,7 +4096,7 @@ Return extended point or nil if not moved." | |||
| 3726 | ; / adornment. | 4096 | ; / adornment. |
| 3727 | (if (< dir 0) ; keep downward adornment. | 4097 | (if (< dir 0) ; keep downward adornment. |
| 3728 | (rst-forward-line (- dir))))) ; step back to adornment. | 4098 | (rst-forward-line (- dir))))) ; step back to adornment. |
| 3729 | (if (looking-at (rst-re 'ttl-beg)) ; may be a title. | 4099 | (if (looking-at (rst-re 'ttl-beg-1)) ; may be a title. |
| 3730 | (if (zerop (rst-forward-line dir)) | 4100 | (if (zerop (rst-forward-line dir)) |
| 3731 | (if (not | 4101 | (if (not |
| 3732 | (looking-at (rst-re 'ado-beg-2-1))) ; no overline / | 4102 | (looking-at (rst-re 'ado-beg-2-1))) ; no overline / |
| @@ -3827,7 +4197,7 @@ next non-empty line if this is indented more than the current one." | |||
| 3827 | "Set the match found earlier if match were found. | 4197 | "Set the match found earlier if match were found. |
| 3828 | Match has been found by `rst-font-lock-find-unindented-line-limit' | 4198 | Match has been found by `rst-font-lock-find-unindented-line-limit' |
| 3829 | the first time called or no match is found. Return non-nil if | 4199 | the first time called or no match is found. Return non-nil if |
| 3830 | match was found. LIMIT is not used but mandated by the caller." | 4200 | match was found. _LIMIT is not used but mandated by the caller." |
| 3831 | (when rst-font-lock-find-unindented-line-end | 4201 | (when rst-font-lock-find-unindented-line-end |
| 3832 | (set-match-data | 4202 | (set-match-data |
| 3833 | (list rst-font-lock-find-unindented-line-begin | 4203 | (list rst-font-lock-find-unindented-line-begin |
| @@ -3846,22 +4216,14 @@ match was found. LIMIT is not used but mandated by the caller." | |||
| 3846 | "Storage for `rst-font-lock-handle-adornment-matcher'. | 4216 | "Storage for `rst-font-lock-handle-adornment-matcher'. |
| 3847 | Either section level of the current adornment or t for a transition.") | 4217 | Either section level of the current adornment or t for a transition.") |
| 3848 | 4218 | ||
| 3849 | (defun rst-adornment-level (key) | 4219 | (defun rst-adornment-level (ado) |
| 3850 | "Return section level for adornment KEY. | 4220 | "Return section level for ADO or t for a transition. |
| 3851 | KEY is the first element of the return list of `rst-classify-adornment'. | 4221 | If ADO is found in the hierarchy return its level. Otherwise |
| 3852 | If KEY is not a cons return it. If KEY is found in the hierarchy return | 4222 | return a level one beyond the existing hierarchy." |
| 3853 | its level. Otherwise return a level one beyond the existing hierarchy." | 4223 | (if (rst-Ado-is-transition ado) |
| 3854 | (if (not (consp key)) | 4224 | t |
| 3855 | key | 4225 | (let ((hier (rst-Hdr-ado-map (rst-hdr-hierarchy)))) |
| 3856 | (let* ((hier (rst-get-hierarchy)) | 4226 | (1+ (or (rst-Ado-position ado hier) |
| 3857 | (char (car key)) | ||
| 3858 | (style (cdr key))) | ||
| 3859 | (1+ (or (lexical-let ((char char) | ||
| 3860 | (style style) | ||
| 3861 | (hier hier)) ; Create closure. | ||
| 3862 | (rst-position-if (lambda (elt) | ||
| 3863 | (and (equal (car elt) char) | ||
| 3864 | (equal (cadr elt) style))) hier)) | ||
| 3865 | (length hier)))))) | 4227 | (length hier)))))) |
| 3866 | 4228 | ||
| 3867 | (defvar rst-font-lock-adornment-match nil | 4229 | (defvar rst-font-lock-adornment-match nil |
| @@ -3878,15 +4240,15 @@ matched. ADO-END is the point where ADO ends. Return the point | |||
| 3878 | where the whole adorned construct ends. | 4240 | where the whole adorned construct ends. |
| 3879 | 4241 | ||
| 3880 | Called as a PRE-MATCH-FORM in the sense of `font-lock-keywords'." | 4242 | Called as a PRE-MATCH-FORM in the sense of `font-lock-keywords'." |
| 3881 | (let ((ado-data (rst-classify-adornment ado ado-end))) | 4243 | (let ((ttl (rst-classify-adornment ado ado-end))) |
| 3882 | (if (not ado-data) | 4244 | (if (not ttl) |
| 3883 | (setq rst-font-lock-adornment-level nil | 4245 | (setq rst-font-lock-adornment-level nil |
| 3884 | rst-font-lock-adornment-match nil) | 4246 | rst-font-lock-adornment-match nil) |
| 3885 | (setq rst-font-lock-adornment-level | 4247 | (setq rst-font-lock-adornment-level |
| 3886 | (rst-adornment-level (car ado-data))) | 4248 | (rst-adornment-level (rst-Ttl-ado ttl))) |
| 3887 | (setq rst-font-lock-adornment-match (cdr ado-data)) | 4249 | (setq rst-font-lock-adornment-match (rst-Ttl-match ttl)) |
| 3888 | (goto-char (nth 1 ado-data)) ; Beginning of construct. | 4250 | (goto-char (rst-Ttl-get-beginning ttl)) |
| 3889 | (nth 2 ado-data)))) ; End of construct. | 4251 | (rst-Ttl-get-end ttl)))) |
| 3890 | 4252 | ||
| 3891 | (defun rst-font-lock-handle-adornment-matcher (_limit) | 4253 | (defun rst-font-lock-handle-adornment-matcher (_limit) |
| 3892 | "Set the match found earlier if match were found. | 4254 | "Set the match found earlier if match were found. |
| @@ -3895,7 +4257,7 @@ Match has been found by | |||
| 3895 | called or no match is found. Return non-nil if match was found. | 4257 | called or no match is found. Return non-nil if match was found. |
| 3896 | 4258 | ||
| 3897 | Called as a MATCHER in the sense of `font-lock-keywords'. | 4259 | Called as a MATCHER in the sense of `font-lock-keywords'. |
| 3898 | LIMIT is not used but mandated by the caller." | 4260 | _LIMIT is not used but mandated by the caller." |
| 3899 | (let ((match rst-font-lock-adornment-match)) | 4261 | (let ((match rst-font-lock-adornment-match)) |
| 3900 | ;; May run only once - enforce this. | 4262 | ;; May run only once - enforce this. |
| 3901 | (setq rst-font-lock-adornment-match nil) | 4263 | (setq rst-font-lock-adornment-match nil) |
| @@ -3933,6 +4295,13 @@ document with \\[rst-compile]." | |||
| 3933 | ".pdf" nil) | 4295 | ".pdf" nil) |
| 3934 | (s5 ,(if (executable-find "rst2s5.py") "rst2s5.py" "rst2s5") | 4296 | (s5 ,(if (executable-find "rst2s5.py") "rst2s5.py" "rst2s5") |
| 3935 | ".html" nil)) | 4297 | ".html" nil)) |
| 4298 | ;; FIXME: Add at least those converters officially supported like `rst2odt' | ||
| 4299 | ;; and `rst2man'. | ||
| 4300 | ;; FIXME: To make this really useful there should be a generic command the | ||
| 4301 | ;; user gives one of the symbols and this way select the conversion to | ||
| 4302 | ;; run. This should replace the toolset stuff somehow. | ||
| 4303 | ;; FIXME: Allow a template for the conversion command so `rst2pdf ... -o ...' | ||
| 4304 | ;; can be supported. | ||
| 3936 | "Table describing the command to use for each tool-set. | 4305 | "Table describing the command to use for each tool-set. |
| 3937 | An association list of the tool-set to a list of the (command to use, | 4306 | An association list of the tool-set to a list of the (command to use, |
| 3938 | extension of produced filename, options to the tool (nil or a | 4307 | extension of produced filename, options to the tool (nil or a |
| @@ -4002,16 +4371,17 @@ select the alternative tool-set." | |||
| 4002 | (outname (file-name-sans-extension bufname))) | 4371 | (outname (file-name-sans-extension bufname))) |
| 4003 | 4372 | ||
| 4004 | ;; Set compile-command before invocation of compile. | 4373 | ;; Set compile-command before invocation of compile. |
| 4005 | (set (make-local-variable 'compile-command) | 4374 | (setq-local |
| 4006 | (mapconcat 'identity | 4375 | compile-command |
| 4007 | (list command | 4376 | (mapconcat 'identity |
| 4008 | (or options "") | 4377 | (list command |
| 4009 | (if conffile | 4378 | (or options "") |
| 4010 | (concat "--config=" (shell-quote-argument conffile)) | 4379 | (if conffile |
| 4011 | "") | 4380 | (concat "--config=" (shell-quote-argument conffile)) |
| 4012 | (shell-quote-argument bufname) | 4381 | "") |
| 4013 | (shell-quote-argument (concat outname extension))) | 4382 | (shell-quote-argument bufname) |
| 4014 | " ")) | 4383 | (shell-quote-argument (concat outname extension))) |
| 4384 | " ")) | ||
| 4015 | 4385 | ||
| 4016 | ;; Invoke the compile command. | 4386 | ;; Invoke the compile command. |
| 4017 | (if (or compilation-read-command use-alt) | 4387 | (if (or compilation-read-command use-alt) |
| @@ -4036,7 +4406,7 @@ buffer, if the region is not selected." | |||
| 4036 | (cadr (assq 'pseudoxml rst-compile-toolsets)) | 4406 | (cadr (assq 'pseudoxml rst-compile-toolsets)) |
| 4037 | standard-output))) | 4407 | standard-output))) |
| 4038 | 4408 | ||
| 4039 | ;; FIXME: Should be defcustom. | 4409 | ;; FIXME: Should be integrated in `rst-compile-toolsets'. |
| 4040 | (defvar rst-pdf-program "xpdf" | 4410 | (defvar rst-pdf-program "xpdf" |
| 4041 | "Program used to preview PDF files.") | 4411 | "Program used to preview PDF files.") |
| 4042 | 4412 | ||
| @@ -4053,7 +4423,8 @@ buffer, if the region is not selected." | |||
| 4053 | ;; output. | 4423 | ;; output. |
| 4054 | )) | 4424 | )) |
| 4055 | 4425 | ||
| 4056 | ;; FIXME: Should be defcustom or use something like `browse-url'. | 4426 | ;; FIXME: Should be integrated in `rst-compile-toolsets' defaulting to |
| 4427 | ;; something like `browse-url'. | ||
| 4057 | (defvar rst-slides-program "firefox" | 4428 | (defvar rst-slides-program "firefox" |
| 4058 | "Program used to preview S5 slides.") | 4429 | "Program used to preview S5 slides.") |
| 4059 | 4430 | ||
| @@ -4070,56 +4441,41 @@ buffer, if the region is not selected." | |||
| 4070 | ;; output. | 4441 | ;; output. |
| 4071 | )) | 4442 | )) |
| 4072 | 4443 | ||
| 4444 | ;; FIXME: Add `rst-compile-html-preview'. | ||
| 4445 | |||
| 4073 | 4446 | ||
| 4074 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 4447 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4075 | ;; Imenu support. | 4448 | ;; Imenu support |
| 4076 | 4449 | ||
| 4077 | ;; FIXME: Integrate this properly. Consider a key binding. | 4450 | ;; FIXME: Consider a key binding. A key binding needs to definitely switch on |
| 4078 | 4451 | ;; `which-func-mode' - i.e. `which-func-modes' must be set properly. | |
| 4079 | ;; Based on code from Masatake YAMATO <yamato@redhat.com>. | 4452 | |
| 4080 | 4453 | ;; Based on ideas from Masatake YAMATO <yamato@redhat.com>. | |
| 4081 | (defun rst-imenu-find-adornments-for-position (adornments pos) | 4454 | |
| 4082 | "Find adornments cell in ADORNMENTS for position POS." | 4455 | (defun rst-imenu-convert-cell (stn) |
| 4083 | (let ((a nil)) | 4456 | "Convert a STN to an Imenu index node and return it." |
| 4084 | (while adornments | 4457 | (let ((ttl (rst-Stn-ttl stn)) |
| 4085 | (if (and (car adornments) | 4458 | (children (rst-Stn-children stn)) |
| 4086 | (eq (car (car adornments)) pos)) | 4459 | (pos (rst-Stn-get-title-beginning stn)) |
| 4087 | (setq a adornments | 4460 | (txt (rst-Stn-get-text stn "")) |
| 4088 | adornments nil) | 4461 | (pfx " ") |
| 4089 | (setq adornments (cdr adornments)))) | 4462 | (sfx "") |
| 4090 | a)) | 4463 | name) |
| 4091 | 4464 | (when ttl | |
| 4092 | (defun rst-imenu-convert-cell (elt adornments) | 4465 | (let ((hdr (rst-Ttl-hdr ttl))) |
| 4093 | "Convert a cell ELT in a tree returned from `rst-section-tree' to Imenu index. | 4466 | (setq pfx (char-to-string (rst-Hdr-get-char hdr))) |
| 4094 | ADORNMENTS is used as hint information for conversion." | 4467 | (when (rst-Hdr-is-over-and-under hdr) |
| 4095 | (let* ((kar (car elt)) | 4468 | (setq sfx pfx)))) |
| 4096 | (kdr (cdr elt)) | 4469 | ;; FIXME: Overline adornment characters need to be in front so they |
| 4097 | (title (car kar))) | 4470 | ;; become visible even for long title lines. May be an additional |
| 4098 | (if kar | 4471 | ;; level number is also useful. |
| 4099 | (let* ((p (marker-position (cadr kar))) | 4472 | (setq name (format "%s%s%s" pfx txt sfx)) |
| 4100 | (adornments | 4473 | (cons name ;; The name of the entry. |
| 4101 | (rst-imenu-find-adornments-for-position adornments p)) | 4474 | (if children |
| 4102 | (a (car adornments)) | 4475 | (cons ;; The entry has a submenu. |
| 4103 | (adornments (cdr adornments)) | 4476 | (cons name pos) ;; The entry itself. |
| 4104 | ;; FIXME: Overline adornment characters need to be in front so | 4477 | (mapcar 'rst-imenu-convert-cell children)) ;; The children. |
| 4105 | ;; they become visible even for long title lines. May be | 4478 | pos)))) ;; The position of a plain entry. |
| 4106 | ;; an additional level number is also useful. | ||
| 4107 | (title (format "%s%s%s" | ||
| 4108 | (make-string (1+ (nth 3 a)) (nth 1 a)) | ||
| 4109 | title | ||
| 4110 | (if (eq (nth 2 a) 'simple) | ||
| 4111 | "" | ||
| 4112 | (char-to-string (nth 1 a)))))) | ||
| 4113 | (cons title | ||
| 4114 | (if (null kdr) | ||
| 4115 | p | ||
| 4116 | (cons | ||
| 4117 | ;; A bit ugly but this make which-func happy. | ||
| 4118 | (cons title p) | ||
| 4119 | (mapcar (lambda (elt0) | ||
| 4120 | (rst-imenu-convert-cell elt0 adornments)) | ||
| 4121 | kdr))))) | ||
| 4122 | nil))) | ||
| 4123 | 4479 | ||
| 4124 | ;; FIXME: Document title and subtitle need to be handled properly. They should | 4480 | ;; FIXME: Document title and subtitle need to be handled properly. They should |
| 4125 | ;; get an own "Document" top level entry. | 4481 | ;; get an own "Document" top level entry. |
| @@ -4127,25 +4483,13 @@ ADORNMENTS is used as hint information for conversion." | |||
| 4127 | "Create index for Imenu. | 4483 | "Create index for Imenu. |
| 4128 | Return as described for `imenu--index-alist'." | 4484 | Return as described for `imenu--index-alist'." |
| 4129 | (rst-reset-section-caches) | 4485 | (rst-reset-section-caches) |
| 4130 | (let ((tree (rst-section-tree)) | 4486 | (let ((root (rst-all-stn))) |
| 4131 | ;; Translate line notation to point notation. | 4487 | (when root |
| 4132 | (adornments (save-excursion | 4488 | (mapcar 'rst-imenu-convert-cell (rst-Stn-children root))))) |
| 4133 | (mapcar (lambda (ln-ado) | ||
| 4134 | (cons (progn | ||
| 4135 | (goto-char (point-min)) | ||
| 4136 | (forward-line (1- (car ln-ado))) | ||
| 4137 | ;; FIXME: Need to consider | ||
| 4138 | ;; `imenu-use-markers' here? | ||
| 4139 | (point)) | ||
| 4140 | (cdr ln-ado))) | ||
| 4141 | (rst-find-all-adornments))))) | ||
| 4142 | (delete nil (mapcar (lambda (elt) | ||
| 4143 | (rst-imenu-convert-cell elt adornments)) | ||
| 4144 | tree)))) | ||
| 4145 | 4489 | ||
| 4146 | 4490 | ||
| 4147 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 4491 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4148 | ;; Generic text functions that are more convenient than the defaults. | 4492 | ;; Convenience functions |
| 4149 | 4493 | ||
| 4150 | ;; FIXME: Unbound command - should be bound or removed. | 4494 | ;; FIXME: Unbound command - should be bound or removed. |
| 4151 | (defun rst-replace-lines (fromchar tochar) | 4495 | (defun rst-replace-lines (fromchar tochar) |
| @@ -4228,12 +4572,12 @@ column is used (fill-column vs. end of previous/next line)." | |||
| 4228 | 4572 | ||
| 4229 | ;; LocalWords: docutils http sourceforge rst html wp svn svnroot txt reST regex | 4573 | ;; LocalWords: docutils http sourceforge rst html wp svn svnroot txt reST regex |
| 4230 | ;; LocalWords: regexes alist seq alt grp keymap abbrev overline overlines toc | 4574 | ;; LocalWords: regexes alist seq alt grp keymap abbrev overline overlines toc |
| 4231 | ;; LocalWords: XML PNT propertized | 4575 | ;; LocalWords: XML PNT propertized init referenceable |
| 4576 | |||
| 4577 | (provide 'rst) | ||
| 4232 | 4578 | ||
| 4233 | ;; Local Variables: | 4579 | ;; Local Variables: |
| 4234 | ;; sentence-end-double-space: t | 4580 | ;; sentence-end-double-space: t |
| 4235 | ;; End: | 4581 | ;; End: |
| 4236 | 4582 | ||
| 4237 | (provide 'rst) | ||
| 4238 | |||
| 4239 | ;;; rst.el ends here | 4583 | ;;; rst.el ends here |