1 ;; Authors: Martin Blais <blais@furius.ca>,
2 ;; David Goodger <goodger@python.org>
4 ;; Copyright: This module has been placed in the public domain.
6 ;; Support code for editing reStructuredText with Emacs indented-text mode.
7 ;; The goal is to create an integrated reStructuredText editing mode.
9 ;; Installation instructions
10 ;; -------------------------
12 ;; Add this line to your .emacs file and bind the versatile sectioning commands
13 ;; in text mode, like this::
15 ;; (require 'restructuredtext)
16 ;; (add-hook 'text-mode-hook 'rest-text-mode-hook)
18 ;; The keys it defines are:
20 ;; C-= : updates or rotates the section title around point or
21 ;; promotes/demotes the decorations within the region (see full details
24 ;; Note that C-= is a good binding, since it allows you to specify a
25 ;; negative arg easily with C-- C-= (easy to type), as well as ordinary
26 ;; prefix arg with C-u C-=.
28 ;; C-x C-= : displays the hierarchical table-of-contents of the document and
29 ;; allows you to jump to any section from it.
31 ;; C-u C-x C-= : displays the title decorations from this file.
33 ;; C-x + : insert the table of contents in the text. See the many options
34 ;; for customizing how it will look.
36 ;; C-M-{, C-M-} : navigate between section titles.
38 ;; Other specialized and more generic functions are also available (see source
39 ;; code). The most important function provided by this file for section title
40 ;; adjustments is rest-adjust.
42 ;; There are many variables that can be customized, look for defcustom and
43 ;; defvar in this file.
45 ;; If you use the table-of-contents feature, you may want to add a hook to
46 ;; update the TOC automatically everytime you adjust a section title::
48 ;; (add-hook 'rest-adjust-hook 'rest-toc-insert-update)
54 ;; rest-toc-insert features
55 ;; ------------------------
56 ;; - Support local table of contents, like in doctree.txt.
57 ;; - On load, detect any existing TOCs and set the properties for links.
58 ;; - TOC insertion should have an option to add empty lines.
59 ;; - TOC insertion should deal with multiple lines
61 ;; - There is a bug on redo after undo of adjust when rest-adjust-hook uses the
62 ;; automatic toc update. The cursor ends up in the TOC and this is
63 ;; annoying. Gotta fix that.
67 ;; - Add an option to forego using the file structure in order to make
68 ;; suggestion, and to always use the preferred decorations to do that.
74 (defun rest-toc-or-hierarchy ()
75 "Binding for either TOC or decorations hierarchy."
77 (if (not current-prefix-arg
)
79 (rest-display-decorations-hierarchy)))
81 (defun rest-text-mode-hook ()
82 "Default text mode hook for rest."
83 (local-set-key [(control ?
=)] 'rest-adjust
)
84 (local-set-key [(control x
)(control ?
=)] 'rest-toc-or-hierarchy
)
85 (local-set-key [(control x
)(?
+)] 'rest-toc-insert
)
86 (local-set-key [(control meta ?
{)] 'rest-backward-section
)
87 (local-set-key [(control meta ?
})] 'rest-forward-section
)
90 ;; Note: we cannot do this because it messes with undo. If we disable undo,
91 ;; since it adds and removes characters, the positions in the undo list are not
92 ;; making sense anymore. Dunno what to do with this, it would be nice to update
95 ;; (add-hook 'write-contents-hooks 'rest-toc-insert-update-fun)
96 ;; (defun rest-toc-insert-update-fun ()
97 ;; ;; Disable undo for the write file hook.
98 ;; (let ((buffer-undo-list t)) (rest-toc-insert-update) ))
102 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103 ;; Generic Filter function.
105 (if (not (fboundp 'filter
))
106 (defun filter (pred list
)
107 "Returns a list of all the elements fulfilling the pred requirement (that
108 is for which (pred elem) is true)"
110 (let ((head (car list
))
111 (tail (filter pred
(cdr list
))))
112 (if (funcall pred head
)
117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
120 (if (not (fboundp 'line-number-at-pos
))
121 (defun line-number-at-pos (&optional pos
)
122 "Return (narrowed) buffer line number at position POS.
123 If POS is nil, use current buffer location."
124 (let ((opoint (or pos
(point))) start
)
126 (goto-char (point-min))
130 (1+ (count-lines start
(point)))))) )
132 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
134 ;; The following functions implement a smart automatic title sectioning feature.
135 ;; The idea is that with the cursor sitting on a section title, we try to get as
136 ;; much information from context and try to do the best thing automatically.
137 ;; This function can be invoked many times and/or with prefix argument to rotate
138 ;; between the various sectioning decorations.
140 ;; Definitions: the two forms of sectioning define semantically separate section
141 ;; levels. A sectioning DECORATION consists in:
145 ;; - a STYLE which can be either of 'simple' or 'over-and-under'.
147 ;; - an INDENT (meaningful for the over-and-under style only) which determines
148 ;; how many characters and over-and-under style is hanging outside of the
149 ;; title at the beginning and ending.
151 ;; Important note: an existing decoration must be formed by at least two
152 ;; characters to be recognized.
154 ;; Here are two examples of decorations (| represents the window border, column
158 ;; 1. char: '-' e |Some Title
159 ;; style: simple |----------
161 ;; 2. char: '=' |==============
162 ;; style: over-and-under | Some Title
163 ;; indent: 2 |==============
168 ;; - The underlining character that is used depends on context. The file is
169 ;; scanned to find other sections and an appropriate character is selected.
170 ;; If the function is invoked on a section that is complete, the character is
171 ;; rotated among the existing section decorations.
173 ;; Note that when rotating the characters, if we come to the end of the
174 ;; hierarchy of decorations, the variable rest-preferred-decorations is
175 ;; consulted to propose a new underline decoration, and if continued, we cycle
176 ;; the decorations all over again. Set this variable to nil if you want to
177 ;; limit the underlining character propositions to the existing decorations in
180 ;; - A prefix argument can be used to alternate the style.
182 ;; - An underline/overline that is not extended to the column at which it should
183 ;; be hanging is dubbed INCOMPLETE. For example::
188 ;; Examples of default invocation:
190 ;; |Some Title ---> |Some Title
193 ;; |Some Title ---> |Some Title
194 ;; |----- |----------
197 ;; | Some Title ---> | Some Title
200 ;; In over-and-under style, when alternating the style, a variable is available
201 ;; to select how much default indent to use (it can be zero). Note that if the
202 ;; current section decoration already has an indent, we don't adjust it to the
203 ;; default, we rather use the current indent that is already there for
204 ;; adjustment (unless we cycle, in which case we use the indent that has been
205 ;; found previously).
207 (defcustom rest-preferred-decorations
'( (?
= over-and-under
1)
215 "Preferred ordering of section title decorations. This
216 sequence is consulted to offer a new decoration suggestion when
217 we rotate the underlines at the end of the existing hierarchy
218 of characters, or when there is no existing section title in
222 (defcustom rest-default-indent
1
223 "Number of characters to indent the section title when toggling
224 decoration styles. This is used when switching from a simple
225 decoration style to a over-and-under decoration style.")
228 (defvar rest-section-text-regexp
"^[ \t]*\\S-*[a-zA-Z0-9]\\S-*"
229 "Regular expression for valid section title text.")
232 (defun rest-line-homogeneous-p (&optional accept-special
)
233 "Predicate return the unique char if the current line is
234 composed only of a single repeated non-whitespace
235 character. This returns the char even if there is whitespace at
236 the beginning of the line.
238 If ACCEPT-SPECIAL is specified we do not ignore special sequences
239 which normally we would ignore when doing a search on many lines.
240 For example, normally we have cases to ignore commonly occuring
241 patterns, such as :: or ...; with the flag do not ignore them."
243 (back-to-indentation)
244 (if (not (looking-at "\n"))
245 (let ((c (thing-at-point 'char
)))
246 (if (and (looking-at (format "[%s]+[ \t]*$" c
))
250 (not (looking-at "::[ \t]*$"))
251 (not (looking-at "\\.\\.\\.[ \t]*$"))
252 ;; Discard one char line
253 (not (looking-at ".[ \t]*$"))
259 (defun rest-line-homogeneous-nodent-p (&optional accept-special
)
262 (if (looking-at "^[ \t]+")
264 (rest-line-homogeneous-p accept-special
)
268 (defun rest-compare-decorations (deco1 deco2
)
269 "Compare decorations. Returns true if both are equal,
270 according to restructured text semantics (only the character and
271 the style are compared, the indentation does not matter."
272 (and (eq (car deco1
) (car deco2
))
273 (eq (cadr deco1
) (cadr deco2
))))
276 (defun rest-get-decoration-match (hier deco
)
277 "Returns the index (level) of the decoration in the given hierarchy.
278 This basically just searches for the item using the appropriate
279 comparison and returns the index. We return nil if the item is
282 (while (and cur
(not (rest-compare-decorations (car cur
) deco
)))
283 (setq cur
(cdr cur
)))
287 (defun rest-suggest-new-decoration (alldecos &optional prev
)
288 "Suggest a new, different decoration, different from all that
291 ALLDECOS is the set of all decorations, including the line
292 numbers. PREV is the optional previous decoration, in order to
293 suggest a better match."
295 ;; For all the preferred decorations...
297 ;; If 'prev' is given, reorder the list to start searching after the
300 (cdr (rest-get-decoration-match rest-preferred-decorations prev
)))
302 ;; List of candidates to search.
303 (curpotential (append fplist rest-preferred-decorations
)))
305 ;; For all the decorations...
308 (while (and cur
(not found
))
309 (if (rest-compare-decorations (car cur
) (car curpotential
))
311 (setq found
(car curpotential
))
312 (setq cur
(cdr cur
))))
315 (setq curpotential
(cdr curpotential
)))
317 (copy-list (car curpotential
)) ))
319 (defun rest-delete-line ()
320 "A version of kill-line that does not use the kill-ring."
321 (delete-region (line-beginning-position) (+ 1 (line-end-position))))
323 (defun rest-update-section (char style
&optional indent
)
324 "Unconditionally updates the style of a section decoration
325 using the given character CHAR, with STYLE 'simple or
326 'over-and-under, and with indent INDENT. If the STYLE is
327 'simple, whitespace before the title is removed (indent is
328 always assume to be 0).
330 If there are existing overline and/or underline from the
331 existing decoration, they are removed before adding the
332 requested decoration."
341 (setq marker
(point-marker))
343 ;; Fixup whitespace at the beginning and end of the line
344 (if (or (null indent
) (eq style
'simple
))
347 (delete-horizontal-space)
348 (insert (make-string indent ?
))
351 (delete-horizontal-space)
353 ;; Set the current column, we're at the end of the title line
354 (setq len
(+ (current-column) indent
))
356 ;; Remove previous line if it consists only of a single repeated character
359 (and (rest-line-homogeneous-p 1)
360 ;; Avoid removing the underline of a title right above us.
361 (save-excursion (forward-line -
1)
362 (not (looking-at rest-section-text-regexp
)))
365 ;; Remove following line if it consists only of a single repeated
369 (and (rest-line-homogeneous-p 1)
371 ;; Add a newline if we're at the end of the buffer, for the subsequence
372 ;; inserting of the underline
373 (if (= (point) (buffer-end 1))
377 (if (eq style
'over-and-under
)
381 (insert (make-string len char
))))
386 (insert (make-string len char
))
393 (defun rest-normalize-cursor-position ()
394 "If the cursor is on a decoration line or an empty line , place
395 it on the section title line (at the end). Returns the line
396 offset by which the cursor was moved. This works both over or
398 (if (save-excursion (beginning-of-line)
399 (or (rest-line-homogeneous-p 1)
400 (looking-at "^[ \t]*$")))
404 ((save-excursion (forward-line -
1)
406 (and (looking-at rest-section-text-regexp
)
407 (not (rest-line-homogeneous-p 1))))
408 (progn (forward-line -
1) -
1))
409 ((save-excursion (forward-line +1)
411 (and (looking-at rest-section-text-regexp
)
412 (not (rest-line-homogeneous-p 1))))
413 (progn (forward-line +1) +1))
418 (defun rest-find-all-decorations ()
419 "Finds all the decorations in the file, and returns a list of
420 (line, decoration) pairs. Each decoration consists in a (char,
421 style, indent) triple.
423 This function does not detect the hierarchy of decorations, it
424 just finds all of them in a file. You can then invoke another
425 function to remove redundancies and inconsistencies."
429 ;; Iterate over all the section titles/decorations in the file.
431 (beginning-of-buffer)
432 (while (< (point) (buffer-end 1))
433 (if (rest-line-homogeneous-nodent-p)
435 (setq curline
(+ curline
(rest-normalize-cursor-position)))
437 ;; Here we have found a potential site for a decoration,
439 (let ((deco (rest-get-decoration)))
440 (if (cadr deco
) ;; Style is existing.
441 ;; Found a real decoration site.
443 (push (cons curline deco
) positions
)
444 ;; Push beyond the underline.
446 (setq curline
(+ curline
1))
450 (setq curline
(+ curline
1))
452 (reverse positions
)))
455 (defun rest-infer-hierarchy (decorations)
456 "Build a hierarchy of decorations using the list of given decorations.
458 This function expects a list of (char, style, indent)
459 decoration specifications, in order that they appear in a file,
460 and will infer a hierarchy of section levels by removing
461 decorations that have already been seen in a forward traversal of the
462 decorations, comparing just the character and style.
464 Similarly returns a list of (char, style, indent), where each
465 list element should be unique."
467 (let ((hierarchy-alist (list)))
468 (dolist (x decorations
)
472 (if (not (assoc (cons char style
) hierarchy-alist
))
474 (setq hierarchy-alist
475 (append hierarchy-alist
476 (list (cons (cons char style
) x
))))
479 (mapcar 'cdr hierarchy-alist
)
483 (defun rest-get-hierarchy (&optional alldecos ignore
)
484 "Returns a list of decorations that represents the hierarchy of
485 section titles in the file.
487 If the line number in IGNORE is specified, the decoration found
488 on that line (if there is one) is not taken into account when
489 building the hierarchy."
490 (let ((all (or alldecos
(rest-find-all-decorations))))
491 (setq all
(assq-delete-all ignore all
))
492 (rest-infer-hierarchy (mapcar 'cdr all
))))
495 (defun rest-get-decoration (&optional point
)
496 "Looks around point and finds the characteristics of the
497 decoration that is found there. We assume that the cursor is
498 already placed on the title line (and not on the overline or
501 This function returns a (char, style, indent) triple. If the
502 characters of overline and underline are different, we return
503 the underline character. The indent is always calculated. A
504 decoration can be said to exist if the style is not nil.
506 A point can be specified to go to the given location before
507 extracting the decoration."
509 (let (char style indent
)
511 (if point
(goto-char point
))
513 (if (looking-at rest-section-text-regexp
)
514 (let* ((over (save-excursion
516 (rest-line-homogeneous-nodent-p)))
518 (under (save-excursion
520 (rest-line-homogeneous-nodent-p)))
523 ;; Check that the line above the overline is not part of a title
527 (and (equal (forward-line -
2) 0)
528 (looking-at rest-section-text-regexp
))))
532 ;; No decoration found, leave all return values nil.
533 ((and (eq over nil
) (eq under nil
)))
535 ;; Overline only, leave all return values nil.
537 ;; Note: we don't return the overline character, but it could perhaps
538 ;; in some cases be used to do something.
539 ((and over
(eq under nil
)))
542 ((and under
(eq over nil
))
546 ;; Both overline and underline.
549 style
'over-and-under
))
554 (setq indent
(save-excursion (back-to-indentation) (current-column)))
557 (list char style indent
)))
560 (defun rest-get-decorations-around (&optional alldecos
)
561 "Given the list of all decorations (with positions),
562 find the decorations before and after the given point.
563 A list of the previous and next decorations is returned."
564 (let* ((all (or alldecos
(rest-find-all-decorations)))
565 (curline (line-number-at-pos))
569 ;; Search for the decorations around the current line.
570 (while (and cur
(< (caar cur
) curline
))
573 ;; 'cur' is the following decoration.
575 (if (and cur
(caar cur
))
576 (setq next
(if (= curline
(caar cur
)) (cdr cur
) cur
)))
578 (mapcar 'cdar
(list prev next
))
582 (defun rest-decoration-complete-p (deco &optional point
)
583 "Return true if the decoration DECO around POINT is complete."
584 ;; Note: we assume that the detection of the overline as being the underline
585 ;; of a preceding title has already been detected, and has been eliminated
586 ;; from the decoration that is given to us.
588 ;; There is some sectioning already present, so check if the current
589 ;; sectioning is complete and correct.
590 (let* ((char (car deco
))
592 (indent (caddr deco
))
593 (endcol (save-excursion (end-of-line) (current-column)))
596 (let ((exps (concat "^"
597 (regexp-quote (make-string (+ endcol indent
) char
))
600 (save-excursion (forward-line +1)
603 (or (not (eq style
'over-and-under
))
604 (save-excursion (forward-line -
1)
611 (defun rest-get-next-decoration
612 (curdeco hier
&optional suggestion reverse-direction
)
613 "Get the next decoration for CURDECO, in given hierarchy HIER,
614 and suggesting for new decoration SUGGESTION."
618 (style (cadr curdeco
))
620 ;; Build a new list of decorations for the rotation.
623 ;; Suggest a new decoration.
625 ;; If nothing to suggest, use first decoration.
628 ;; Search for next decoration.
630 (let ((cur (if reverse-direction rotdecos
634 (not (and (eq char
(caar cur
))
635 (eq style
(cadar cur
)))))
636 (setq cur
(cdr cur
)))
639 ;; If not found, take the first of all decorations.
644 (defun rest-adjust ()
645 "Adjust/rotate the section decoration for the section title
646 around point or promote/demote the decorations inside the region,
647 depending on if the region is active. This function is meant to
648 be invoked possibly multiple times, and can vary its behaviour
649 with a positive prefix argument (toggle style), or with a
650 negative prefix argument (alternate behaviour).
652 This function is the main focus of this module and is a bit of a
653 swiss knife. It is meant as the single most essential function
654 to be bound to invoke to adjust the decorations of a section
655 title in restructuredtext. It tries to deal with all the
656 possible cases gracefully and to do `the right thing' in all
659 See the documentations of rest-adjust-decoration and
660 rest-promote-region for full details.
665 The method can take either (but not both) of
667 a. a (non-negative) prefix argument, which means to toggle the
668 decoration style. Invoke with C-u prefix for example;
670 b. a negative numerical argument, which generally inverts the
671 direction of search in the file or hierarchy. Invoke with C--
677 (let* ( ;; Parse the positive and negative prefix arguments.
679 (and current-prefix-arg
680 (< (prefix-numeric-value current-prefix-arg
) 0)))
682 (and current-prefix-arg
(not reverse-direction
))))
684 (if (and transient-mark-mode mark-active
)
685 ;; Adjust decorations within region.
686 (rest-promote-region current-prefix-arg
)
687 ;; Adjust decoration around point.
688 (rest-adjust-decoration toggle-style reverse-direction
))
690 ;; Run the hooks to run after adjusting.
691 (run-hooks 'rest-adjust-hook
)
695 (defvar rest-adjust-hook nil
696 "Hooks to be run after running rest-adjust.")
698 (defun rest-adjust-decoration (&optional toggle-style reverse-direction
)
699 "Adjust/rotate the section decoration for the section title around point.
701 This function is meant to be invoked possibly multiple times, and
702 can vary its behaviour with a true TOGGLE-STYLE argument, or with
703 a REVERSE-DIRECTION argument.
708 The next action it takes depends on context around the point, and
709 it is meant to be invoked possibly more than once to rotate among
710 the various possibilities. Basically, this function deals with:
712 - adding a decoration if the title does not have one;
714 - adjusting the length of the underline characters to fit a
717 - rotating the decoration in the set of already existing
718 sectioning decorations used in the file;
720 - switching between simple and over-and-under styles.
722 You should normally not have to read all the following, just
723 invoke the method and it will do the most obvious thing that you
727 Decoration Definitions
728 ======================
730 The decorations consist in
734 2. a STYLE which can be either of 'simple' or 'over-and-under'.
736 3. an INDENT (meaningful for the over-and-under style only)
737 which determines how many characters and over-and-under
738 style is hanging outside of the title at the beginning and
741 See source code for mode details.
744 Detailed Behaviour Description
745 ==============================
747 Here are the gory details of the algorithm (it seems quite
748 complicated, but really, it does the most obvious thing in all
749 the particular cases):
751 Before applying the decoration change, the cursor is placed on
752 the closest line that could contain a section title.
754 Case 1: No Decoration
755 ---------------------
757 If the current line has no decoration around it,
759 - search backwards for the last previous decoration, and apply
760 the decoration one level lower to the current line. If there
761 is no defined level below this previous decoration, we suggest
762 the most appropriate of the rest-preferred-decorations.
764 If REVERSE-DIRECTION is true, we simply use the previous
765 decoration found directly.
767 - if there is no decoration found in the given direction, we use
768 the first of rest-preferred-decorations.
770 The prefix argument forces a toggle of the prescribed decoration
773 Case 2: Incomplete Decoration
774 -----------------------------
776 If the current line does have an existing decoration, but the
777 decoration is incomplete, that is, the underline/overline does
778 not extend to exactly the end of the title line (it is either too
779 short or too long), we simply extend the length of the
780 underlines/overlines to fit exactly the section title.
782 If the prefix argument is given, we toggle the style of the
785 REVERSE-DIRECTION has no effect in this case.
787 Case 3: Complete Existing Decoration
788 ------------------------------------
790 If the decoration is complete (i.e. the underline (overline)
791 length is already adjusted to the end of the title line), we
792 search/parse the file to establish the hierarchy of all the
793 decorations (making sure not to include the decoration around
794 point), and we rotate the current title's decoration from within
795 that list (by default, going *down* the hierarchy that is present
796 in the file, i.e. to a lower section level). This is meant to be
797 used potentially multiple times, until the desired decoration is
798 found around the title.
800 If we hit the boundary of the hierarchy, exactly one choice from
801 the list of preferred decorations is suggested/chosen, the first
802 of those decoration that has not been seen in the file yet (and
803 not including the decoration around point), and the next
804 invocation rolls over to the other end of the hierarchy (i.e. it
805 cycles). This allows you to avoid having to set which character
806 to use by always using the
808 If REVERSE-DIRECTION is true, the effect is to change the
809 direction of rotation in the hierarchy of decorations, thus
810 instead going *up* the hierarchy.
812 However, if there is a non-negative prefix argument, we do not
813 rotate the decoration, but instead simply toggle the style of the
814 current decoration (this should be the most common way to toggle
815 the style of an existing complete decoration).
821 The invocation of this function can be carried out anywhere
822 within the section title line, on an existing underline or
823 overline, as well as on an empty line following a section title.
824 This is meant to be as convenient as possible.
830 Indented section titles such as ::
835 are illegal in restructuredtext and thus not recognized by the
836 parser. This code will thus not work in a way that would support
837 indented sections (it would be ambiguous anyway).
843 Section titles that are right next to each other may not be
844 treated well. More work might be needed to support those, and
845 special conditions on the completeness of existing decorations
846 might be required to make it non-ambiguous.
848 For now we assume that the decorations are disjoint, that is,
849 there is at least a single line between the titles/decoration
856 We suggest that you bind this function on C-=. It is close to
857 C-- so a negative argument can be easily specified with a flick
858 of the right hand fingers and the binding is unused in text-mode."
861 ;; If we were invoked directly, parse the prefix arguments into the
862 ;; arguments of the function.
863 (if current-prefix-arg
864 (setq reverse-direction
865 (and current-prefix-arg
866 (< (prefix-numeric-value current-prefix-arg
) 0))
869 (and current-prefix-arg
(not reverse-direction
))))
871 (let* (;; Check if we're on an underline around a section title, and move the
872 ;; cursor to the title if this is the case.
873 (moved (rest-normalize-cursor-position))
875 ;; Find the decoration and completeness around point.
876 (curdeco (rest-get-decoration))
878 (style (cadr curdeco
))
879 (indent (caddr curdeco
))
881 ;; New values to be computed.
882 char-new style-new indent-new
885 ;; We've moved the cursor... if we're not looking at some text, we have
887 (if (save-excursion (beginning-of-line)
888 (looking-at rest-section-text-regexp
))
891 ;;---------------------------------------------------------------------
892 ;; Case 1: No Decoration
893 ((and (eq char nil
) (eq style nil
))
895 (let* ((alldecos (rest-find-all-decorations))
897 (around (rest-get-decorations-around alldecos
))
901 (hier (rest-get-hierarchy alldecos
))
904 ;; Advance one level down.
907 (if (not reverse-direction
)
908 (or (cadr (rest-get-decoration-match hier prev
))
909 (rest-suggest-new-decoration hier prev
))
911 (copy-list (car rest-preferred-decorations
))
914 ;; Invert the style if requested.
916 (setcar (cdr cur
) (if (eq (cadr cur
) 'simple
)
917 'over-and-under
'simple
)) )
919 (setq char-new
(car cur
)
921 indent-new
(caddr cur
))
924 ;;---------------------------------------------------------------------
925 ;; Case 2: Incomplete Decoration
926 ((not (rest-decoration-complete-p curdeco
))
928 ;; Invert the style if requested.
930 (setq style
(if (eq style
'simple
) 'over-and-under
'simple
)))
936 ;;---------------------------------------------------------------------
937 ;; Case 3: Complete Existing Decoration
941 ;; Simply switch the style of the current decoration.
943 style-new
(if (eq style
'simple
) 'over-and-under
'simple
)
944 indent-new rest-default-indent
)
946 ;; Else, we rotate, ignoring the decoration around the current
948 (let* ((alldecos (rest-find-all-decorations))
950 (hier (rest-get-hierarchy alldecos
(line-number-at-pos)))
952 ;; Suggestion, in case we need to come up with something
954 (suggestion (rest-suggest-new-decoration
956 (car (rest-get-decorations-around alldecos
))))
958 (nextdeco (rest-get-next-decoration
959 curdeco hier suggestion reverse-direction
))
963 ;; Indent, if present, always overrides the prescribed indent.
964 (setq char-new
(car nextdeco
)
965 style-new
(cadr nextdeco
)
966 indent-new
(caddr nextdeco
))
971 ;; Override indent with present indent!
972 (setq indent-new
(if (> indent
0) indent indent-new
))
974 (if (and char-new style-new
)
975 (rest-update-section char-new style-new indent-new
))
979 ;; Correct the position of the cursor to more accurately reflect where it
980 ;; was located when the function was invoked.
981 (if (not (= moved
0))
982 (progn (forward-line (- moved
))
987 ;; Maintain an alias for compatibility.
988 (defalias 'rest-adjust-section-title
'rest-adjust
)
991 (defun rest-promote-region (&optional demote
)
992 "Promote the section titles within the region.
994 With argument DEMOTE or a prefix argument, demote the
995 section titles instead. The algorithm used at the boundaries of
996 the hierarchy is similar to that used by rest-adjust-decoration."
999 (let* ((demote (or current-prefix-arg demote
))
1000 (alldecos (rest-find-all-decorations))
1003 (hier (rest-get-hierarchy alldecos
))
1004 (suggestion (rest-suggest-new-decoration hier
))
1006 (region-begin-line (line-number-at-pos (region-beginning)))
1007 (region-end-line (line-number-at-pos (region-end)))
1012 ;; Skip the markers that come before the region beginning
1013 (while (and cur
(< (caar cur
) region-begin-line
))
1014 (setq cur
(cdr cur
)))
1016 ;; Create a list of markers for all the decorations which are found within
1020 (while (and cur
(< (setq line
(caar cur
)) region-end-line
))
1021 (setq m
(make-marker))
1023 (push (list (set-marker m
(point)) (cdar cur
)) marker-list
)
1024 (setq cur
(cdr cur
)) ))
1026 ;; Apply modifications.
1028 (dolist (p marker-list
)
1029 ;; Go to the decoration to promote.
1032 ;; Rotate the next decoration.
1033 (setq nextdeco
(rest-get-next-decoration
1034 (cadr p
) hier suggestion demote
))
1036 ;; Update the decoration.
1037 (apply 'rest-update-section nextdeco
)
1039 ;; Clear marker to avoid slowing down the editing after we're done.
1040 (set-marker (car p
) nil
)
1042 (setq deactivate-mark nil
)
1047 (defun rest-display-decorations-hierarchy (&optional decorations
)
1048 "Display the current file's section title decorations hierarchy.
1049 This function expects a list of (char, style, indent) triples."
1052 (if (not decorations
)
1053 (setq decorations
(rest-get-hierarchy)))
1054 (with-output-to-temp-buffer "*rest section hierarchy*"
1056 (with-current-buffer standard-output
1057 (dolist (x decorations
)
1058 (insert (format "\nSection Level %d" level
))
1059 (apply 'rest-update-section x
)
1067 (defun rest-rstrip (str)
1068 "Strips the whitespace at the end of a string."
1070 (string-match "[ \t\n]*\\'" str
)
1071 (substring str
0 (match-beginning 0))
1074 (defun rest-get-stripped-line ()
1075 "Returns the line at cursor, stripped from whitespace."
1076 (re-search-forward "\\S-.*\\S-" (line-end-position))
1077 (buffer-substring-no-properties (match-beginning 0)
1081 (defcustom rest-toc-indent
2
1082 "Indentation for table-of-contents display (also used for
1083 formatting insertion, when numbering is disabled).")
1086 (defun rest-section-tree (alldecos)
1087 "Returns a pair of a hierarchical tree of the sections titles
1088 in the document, and a reference to the node where the cursor
1089 lives. This can be used to generate a table of contents for the
1092 Each section title consists in a cons of the stripped title
1093 string and a marker to the section in the original text document.
1095 If there are missing section levels, the section titles are
1096 inserted automatically, and are set to nil."
1099 (hier (rest-get-hierarchy alldecos
))
1100 (levels (make-hash-table :test
'equal
:size
10))
1105 (puthash deco lev levels
)
1108 ;; Create a list of lines that contains (text, level, marker) for each
1112 (mapcar (lambda (deco)
1113 (goto-line (car deco
))
1114 (list (gethash (cdr deco
) levels
)
1115 (rest-get-stripped-line)
1116 (let ((m (make-marker)))
1117 (beginning-of-line 1)
1118 (set-marker m
(point)))
1122 (let ((lcontnr (cons nil lines
)))
1123 (rest-section-tree-rec lcontnr -
1))))
1126 (defun rest-section-tree-rec (decos lev
)
1127 "Recursive function for the implementation of the section tree
1128 building. DECOS is a cons cell whose cdr is the remaining list
1129 of decorations, and we change it as we consume them. LEV is
1130 the current level of that node. This function returns a pair
1131 of the subtree that was built. This treats the decos list
1134 (let ((ndeco (cadr decos
))
1137 ;; If the next decoration matches our level
1138 (if (= (car ndeco
) lev
)
1140 ;; Pop the next decoration and create the current node with it
1141 (setcdr decos
(cddr decos
))
1142 (setq node
(cdr ndeco
)) ))
1143 ;; Else we let the node title/marker be unset.
1145 ;; Build the child nodes
1146 (while (and (cdr decos
) (> (caadr decos
) lev
))
1148 (cons (rest-section-tree-rec decos
(1+ lev
))
1151 ;; Return this node with its children.
1152 (cons node
(reverse children
))
1156 (defun rest-toc-insert (&optional pfxarg
)
1157 "Insert a simple text rendering of the table of contents.
1158 By default the top level is ignored if there is only one, because
1159 we assume that the document will have a single title.
1161 If a numeric prefix argument is given,
1162 - if it is zero or generic, include the top level titles;
1163 - otherwise insert the TOC up to the specified level.
1165 The TOC is inserted indented at the current column."
1169 (let* (;; Check maximum level override
1170 (rest-toc-insert-max-level
1171 (if (and (integerp pfxarg
) (> (prefix-numeric-value pfxarg
) 0))
1172 (prefix-numeric-value pfxarg
) rest-toc-insert-max-level
))
1174 ;; Get the section tree.
1175 (sectree (rest-section-tree (rest-find-all-decorations)))
1177 ;; If there is only one top-level title, remove it by starting to print
1178 ;; one index lower (revert this behaviour with the prefix arg),
1179 ;; otherwise print all.
1180 (gen-pfx-arg (or (and pfxarg
(listp pfxarg
))
1181 (and (integerp pfxarg
)
1182 (= (prefix-numeric-value pfxarg
) 0))))
1183 (start-lev (if (and (not rest-toc-insert-always-include-top
)
1184 (= (length (cdr sectree
)) 1)
1185 (not gen-pfx-arg
)) -
1 0))
1187 ;; Figure out initial indent.
1188 (initial-indent (make-string (current-column) ?
))
1189 (init-point (point)))
1191 (rest-toc-insert-node sectree start-lev initial-indent
"")
1193 ;; Fixup for the first line.
1194 (delete-region init-point
(+ init-point
(length initial-indent
)))
1196 ;; Delete the last newline added.
1197 (delete-backward-char 1)
1201 (defcustom rest-toc-insert-always-include-top nil
1202 "Set this to 't if you want to always include top-level titles,
1203 even when there is only one.")
1205 (defcustom rest-toc-insert-style
'fixed
1206 "Set this to one of the following values to determine numbering and
1208 - plain: no numbering (fixed indentation)
1209 - fixed: numbering, but fixed indentation
1210 - aligned: numbering, titles aligned under each other
1211 - listed: numbering, with dashes like list items (EXPERIMENTAL)
1214 (defcustom rest-toc-insert-number-separator
" "
1215 "Separator that goes between the TOC number and the title.")
1217 ;; This is used to avoid having to change the user's mode.
1218 (defvar rest-toc-insert-click-keymap
1219 (let ((map (make-sparse-keymap)))
1220 (define-key map
[mouse-1
] 'rest-toc-mode-mouse-goto
)
1222 "(Internal) What happens when you click on propertized text in the TOC.")
1224 (defcustom rest-toc-insert-max-level nil
1225 "If non-nil, maximum depth of the inserted TOC.")
1227 (defun rest-toc-insert-node (node level indent pfx
)
1228 "Recursive function that does the print of the inserted
1229 toc. PFX is the prefix numbering, that includes the alignment
1230 necessary for all the children of this level to align."
1231 (let ((do-print (> level
0))
1238 (if (not (equal rest-toc-insert-style
'plain
))
1239 (insert pfx rest-toc-insert-number-separator
))
1240 (insert (or (caar node
) "[missing node]"))
1241 ;; Add properties to the text, even though in normal text mode it
1242 ;; won't be doing anything for now. Not sure that I want to change
1243 ;; mode stuff. At least the highlighting gives the idea that this
1244 ;; is generated automatically.
1245 (put-text-property b
(point) 'mouse-face
'highlight
)
1246 (put-text-property b
(point) 'rest-toc-target
(cadar node
))
1247 (put-text-property b
(point) 'keymap rest-toc-insert-click-keymap
)
1252 ;; Prepare indent for children.
1255 ((eq rest-toc-insert-style
'plain
)
1256 (concat indent rest-toc-indent
))
1258 ((eq rest-toc-insert-style
'fixed
)
1259 (concat indent
(make-string rest-toc-indent ?
)))
1261 ((eq rest-toc-insert-style
'aligned
)
1262 (concat indent
(make-string (+ (length pfx
) 2) ?
)))
1264 ((eq rest-toc-insert-style
'listed
)
1265 (concat (substring indent
0 -
3)
1266 (concat (make-string (+ (length pfx
) 2) ?
) " - ")))
1271 (if (or (eq rest-toc-insert-max-level nil
)
1272 (< level rest-toc-insert-max-level
))
1273 (let ((do-child-numbering (>= level
0))
1275 (if do-child-numbering
1277 ;; Add a separating dot if there is already a prefix
1278 (if (> (length pfx
) 0)
1279 (setq pfx
(concat (rest-rstrip pfx
) ".")))
1281 ;; Calculate the amount of space that the prefix will require for
1284 (setq fmt
(format "%%-%dd"
1285 (1+ (floor (log10 (length (cdr node
))))))))
1288 (dolist (child (cdr node
))
1289 (rest-toc-insert-node child
1292 (if do-child-numbering
1293 (concat pfx
(format fmt count
)) pfx
))
1299 (defun rest-toc-insert-find-delete-contents ()
1300 "Finds and deletes an existing comment after the first contents directive and
1301 delete that region. Return t if found and the cursor is left after the comment."
1302 (goto-char (point-min))
1303 ;; We look for the following and the following only (in other words, if your
1304 ;; syntax differs, this won't work. If you would like a more flexible thing,
1305 ;; contact the author, I just can't imagine that this requirement is
1306 ;; unreasonable for now).
1308 ;; .. contents:: [...anything here...]
1315 (re-search-forward "^\\.\\. contents[ \t]*::\\(.*\\)\n\\.\\."
1319 ;; Look for the first line that starts at the first column.
1322 (while (or (and (looking-at "[ \t]+[^ \t]")
1323 (setq last-real
(point)) t
)
1324 (looking-at "\\s-*$"))
1329 (goto-char last-real
)
1331 (delete-region beg
(point)))
1336 (defun rest-toc-insert-update ()
1337 "Automatically find the .. contents:: section of a document and update the
1338 inserted TOC if present. You can use this in your file-write hook to always
1339 make it up-to-date automatically."
1342 (if (rest-toc-insert-find-delete-contents)
1343 (progn (insert "\n ")
1344 (rest-toc-insert))) )
1345 ;; Note: always return nil, because this may be used as a hook.
1349 ;;------------------------------------------------------------------------------
1351 (defun rest-toc-node (node level
)
1352 "Recursive function that does the print of the TOC in rest-toc-mode."
1356 ;; Insert line text.
1357 (insert (make-string (* rest-toc-indent
(1- level
)) ?
))
1358 (insert (if (car node
) (caar node
) "[missing node]"))
1361 (put-text-property b
(point) 'mouse-face
'highlight
)
1363 ;; Add link on lines.
1364 (put-text-property b
(point) 'rest-toc-target
(cadar node
))
1368 (dolist (child (cdr node
))
1369 (rest-toc-node child
(1+ level
))))
1373 "Finds all the section titles and their decorations in the
1374 file, and displays a hierarchically-organized list of the
1375 titles, which is essentially a table-of-contents of the
1378 The emacs buffer can be navigated, and selecting a section
1379 brings the cursor in that section."
1381 (let* ((curbuf (current-buffer))
1384 ;; Get the section tree
1385 (alldecos (rest-find-all-decorations))
1386 (sectree (rest-section-tree alldecos
))
1388 ;; Create a temporary buffer.
1389 (buf (get-buffer-create rest-toc-buffer-name
))
1392 ;; Find the index of the section where the cursor currently is.
1393 (setq outline
(let ((idx 1)
1394 (curline (line-number-at-pos (point)))
1396 (while (and decos
(<= (caar decos
) curline
))
1397 (setq decos
(cdr decos
))
1400 ;; FIXME: if there is a missing node inserted, the calculation of the
1401 ;; current line will be off. You need to fix this by moving the finding of
1402 ;; the current line somewhere else.
1405 (with-current-buffer buf
1406 (let ((inhibit-read-only t
))
1408 (delete-region (point-min) (point-max))
1409 (insert (format "Table of Contents: %s\n" (or (caar sectree
) "")))
1410 (put-text-property (point-min) (point)
1411 'face
(list '(background-color .
"lightgray")))
1412 (rest-toc-node sectree
0)
1414 (display-buffer buf
)
1417 ;; Save the buffer to return to.
1418 (set (make-local-variable 'rest-toc-return-buffer
) curbuf
)
1420 ;; Move the cursor near the right section in the TOC.
1425 (defun rest-toc-mode-find-section ()
1426 (let ((pos (get-text-property (point) 'rest-toc-target
)))
1428 (error "No section on this line"))
1429 (unless (buffer-live-p (marker-buffer pos
))
1430 (error "Buffer for this section was killed"))
1433 (defvar rest-toc-buffer-name
"*Table of Contents*"
1434 "Name of the Table of Contents buffer.")
1436 (defun rest-toc-mode-goto-section ()
1437 "Go to the section the current line describes."
1439 (let ((pos (rest-toc-mode-find-section)))
1440 (kill-buffer (get-buffer rest-toc-buffer-name
))
1441 (pop-to-buffer (marker-buffer pos
))
1445 (defun rest-toc-mode-mouse-goto (event)
1446 "In Rest-Toc mode, go to the occurrence whose line you click on."
1450 (set-buffer (window-buffer (posn-window (event-end event
))))
1452 (goto-char (posn-point (event-end event
)))
1453 (setq pos
(rest-toc-mode-find-section))))
1454 (pop-to-buffer (marker-buffer pos
))
1457 (defun rest-toc-mode-mouse-goto-kill (event)
1459 (call-interactively 'rest-toc-mode-mouse-goto event
)
1460 (kill-buffer (get-buffer rest-toc-buffer-name
)))
1462 (defvar rest-toc-return-buffer nil
1463 "Buffer local variable that is used to return to the original
1464 buffer from the TOC.")
1466 (defun rest-toc-quit-window ()
1469 (pop-to-buffer rest-toc-return-buffer
))
1471 (defvar rest-toc-mode-map
1472 (let ((map (make-sparse-keymap)))
1473 (define-key map
[mouse-1
] 'rest-toc-mode-mouse-goto-kill
)
1474 (define-key map
[mouse-2
] 'rest-toc-mode-mouse-goto
)
1475 (define-key map
"\C-m" 'rest-toc-mode-goto-section
)
1476 (define-key map
"f" 'rest-toc-mode-goto-section
)
1477 (define-key map
"q" 'rest-toc-quit-window
)
1478 (define-key map
"z" 'kill-this-buffer
)
1480 "Keymap for `rest-toc-mode'.")
1482 (put 'rest-toc-mode
'mode-class
'special
)
1484 (defun rest-toc-mode ()
1485 "Major mode for output from \\[rest-toc]."
1487 (kill-all-local-variables)
1488 (use-local-map rest-toc-mode-map
)
1489 (setq major-mode
'rest-toc-mode
)
1490 (setq mode-name
"Rest-TOC")
1491 (setq buffer-read-only t
)
1494 ;; Note: use occur-mode (replace.el) as a good example to complete missing
1498 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1500 ;; Section movement commands.
1503 (defun rest-forward-section (&optional offset
)
1504 "Skip to the next restructured text section title.
1505 OFFSET specifies how many titles to skip. Use a negative OFFSET to move
1506 backwards in the file (default is to use 1)."
1508 (let* (;; Default value for offset.
1509 (offset (or offset
1))
1511 ;; Get all the decorations in the file, with their line numbers.
1512 (alldecos (rest-find-all-decorations))
1514 ;; Get the current line.
1515 (curline (line-number-at-pos))
1522 ;; Find the index of the "next" decoration w.r.t. to the current line.
1523 (while (and cur
(< (caar cur
) curline
))
1524 (setq cur
(cdr cur
))
1526 ;; 'cur' is the decoration on or following the current line.
1528 (if (and (> offset
0) cur
(= (caar cur
) curline
))
1531 ;; Find the final index.
1532 (setq idx
(+ idx
(if (> offset
0) (- offset
1) offset
)))
1533 (setq cur
(nth idx alldecos
))
1535 ;; If the index is positive, goto the line, otherwise go to the buffer
1537 (if (and cur
(>= idx
0))
1538 (goto-line (car cur
))
1539 (if (> offset
0) (end-of-buffer) (beginning-of-buffer)))
1542 (defun rest-backward-section ()
1543 "Like rest-forward-section, except move back one title."
1545 (rest-forward-section -
1))
1554 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1556 ;; Generic text functions that are more convenient than the defaults.
1559 (defun replace-lines (fromchar tochar
)
1560 "Replace flush-left lines, consisting of multiple FROMCHAR characters,
1561 with equal-length lines of TOCHAR."
1563 cSearch for flush-left lines of char:
1564 cand replace with char: ")
1566 (let* ((fromstr (string fromchar
))
1567 (searchre (concat "^" (regexp-quote fromstr
) "+ *$"))
1571 (search-forward-regexp searchre
)
1572 (setq found
(1+ found
))
1573 (search-backward fromstr
) ;; point will be *before* last char
1574 (setq p
(1+ (point)))
1576 (setq l
(- p
(point)))
1578 (insert-char tochar l
))
1580 (message (format "%d lines replaced." found
)))))))
1582 (defun join-paragraph ()
1583 "Join lines in current paragraph into one line, removing end-of-lines."
1585 (let ((fill-column 65000)) ; some big number
1586 (call-interactively 'fill-paragraph
)))
1588 (defun force-fill-paragraph ()
1589 "Fill paragraph at point, first joining the paragraph's lines into one.
1590 This is useful for filling list item paragraphs."
1593 (fill-paragraph nil
))
1597 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1599 ;; Generic character repeater function.
1601 ;; For sections, better to use the specialized function above, but this can
1602 ;; be useful for creating separators.
1604 (defun repeat-last-character (&optional tofill
)
1605 "Fills the current line up to the length of the preceding line (if not
1606 empty), using the last character on the current line. If the preceding line is
1607 empty, we use the fill-column.
1609 If a prefix argument is provided, use the next line rather than the preceding
1612 If the current line is longer than the desired length, shave the characters off
1613 the current line to fit the desired length.
1615 As an added convenience, if the command is repeated immediately, the alternative
1616 column is used (fill-column vs. end of previous/next line)."
1618 (let* ((curcol (current-column))
1619 (curline (+ (count-lines (point-min) (point))
1620 (if (eq curcol
0) 1 0)))
1621 (lbp (line-beginning-position 0))
1622 (prevcol (if (and (= curline
1) (not current-prefix-arg
))
1625 (forward-line (if current-prefix-arg
1 -
1))
1627 (skip-chars-backward " \t" lbp
)
1628 (let ((cc (current-column)))
1629 (if (= cc
0) fill-column cc
)))))
1631 (cond (tofill fill-column
)
1632 ((equal last-command
'repeat-last-character
)
1633 (if (= curcol fill-column
) prevcol fill-column
))
1635 (if (= prevcol
0) fill-column prevcol
)))
1638 (if (> (current-column) rightmost-column
)
1639 ;; shave characters off the end
1640 (delete-region (- (point)
1641 (- (current-column) rightmost-column
))
1643 ;; fill with last characters
1644 (insert-char (preceding-char)
1645 (- rightmost-column
(current-column))))
1649 (provide 'restructuredtext
)