lisp/textmodes/rst.el

   1 ;;; rst.el --- Mode for viewing and editing reStructuredText-documents.
   2
   3 ;; Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
   4 ;;   Free Software Foundation, Inc.
   5
   6 ;; Authors: Martin Blais <blais@furius.ca>,
   7 ;;          Stefan Merten <smerten@oekonux.de>,
   8 ;;          David Goodger <goodger@python.org>
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; This package provides major mode rst-mode, which supports documents marked up
  28 ;; using the reStructuredText format.  Support includes font locking as well as
  29 ;; some convenience functions for editing.  It does this by defining a Emacs
  30 ;; major mode: rst-mode (ReST).  This mode is derived from text-mode (and
  31 ;; inherits much of it).  This package also contains:
  32 ;;
  33 ;; - Functions to automatically adjust and cycle the section underline
  34 ;;   decorations;
  35 ;; - A mode that displays the table of contents and allows you to jump anywhere
  36 ;;   from it;
  37 ;; - Functions to insert and automatically update a TOC in your source
  38 ;;   document;
  39 ;; - Font-lock highlighting of notable reStructuredText structures;
  40 ;; - Some other convenience functions.
  41 ;;
  42 ;; See the accompanying document in the docutils documentation about
  43 ;; the contents of this package and how to use it.
  44 ;;
  45 ;; For more information about reStructuredText, see
  46 ;; http://docutils.sourceforge.net/rst.html
  47 ;;
  48 ;; For full details on how to use the contents of this file, see
  49 ;; http://docutils.sourceforge.net/docs/user/emacs.html
  50 ;;
  51 ;;
  52 ;; There are a number of convenient keybindings provided by rst-mode.
  53 ;; The main one is
  54 ;;
  55 ;;    C-c C-a (also C-=): rst-adjust
  56 ;;
  57 ;; Updates or rotates the section title around point or promotes/demotes the
  58 ;; decorations within the region (see full details below).  Note that C-= is a
  59 ;; good binding, since it allows you to specify a negative arg easily with C--
  60 ;; C-= (easy to type), as well as ordinary prefix arg with C-u C-=.
  61 ;;
  62 ;; For more on bindings, see rst-mode-map below.  There are also many variables
  63 ;; that can be customized, look for defcustom and defvar in this file.
  64 ;;
  65 ;; If you use the table-of-contents feature, you may want to add a hook to
  66 ;; update the TOC automatically everytime you adjust a section title::
  67 ;;
  68 ;;   (add-hook 'rst-adjust-hook 'rst-toc-update)
  69 ;;
  70 ;; Syntax highlighting: font-lock is enabled by default.  If you want to turn
  71 ;; off syntax highlighting to rst-mode, you can use the following::
  72 ;;
  73 ;;   (setq font-lock-global-modes '(not rst-mode ...))
  74 ;;
  75
  76
  77 ;; CUSTOMIZATION
  78 ;;
  79 ;; rst
  80 ;; ---
  81 ;; This group contains some general customizable features.
  82 ;;
  83 ;; The group is contained in the wp group.
  84 ;;
  85 ;; rst-faces
  86 ;; ---------
  87 ;; This group contains all necessary for customizing fonts.  The default
  88 ;; settings use standard font-lock-*-face's so if you set these to your
  89 ;; liking they are probably good in rst-mode also.
  90 ;;
  91 ;; The group is contained in the faces group as well as in the rst group.
  92 ;;
  93 ;; rst-faces-defaults
  94 ;; ------------------
  95 ;; This group contains all necessary for customizing the default fonts used for
  96 ;; section title faces.
  97 ;;
  98 ;; The general idea for section title faces is to have a non-default background
  99 ;; but do not change the background.  The section level is shown by the
 100 ;; lightness of the background color.  If you like this general idea of
 101 ;; generating faces for section titles but do not like the details this group
 102 ;; is the point where you can customize the details.  If you do not like the
 103 ;; general idea, however, you should customize the faces used in
 104 ;; rst-adornment-faces-alist.
 105 ;;
 106 ;; Note: If you are using a dark background please make sure the variable
 107 ;; frame-background-mode is set to the symbol dark.  This triggers
 108 ;; some default values which are probably right for you.
 109 ;;
 110 ;; The group is contained in the rst-faces group.
 111 ;;
 112 ;; All customizable features have a comment explaining their meaning.
 113 ;; Refer to the customization of your Emacs (try ``M-x customize``).
 114
 115
 116 ;;; DOWNLOAD
 117
 118 ;; The latest version of this file lies in the docutils source code repository:
 119 ;;   http://svn.berlios.de/svnroot/repos/docutils/trunk/docutils/tools/editors/emacs/rst.el
 120
 121
 122 ;;; INSTALLATION
 123
 124 ;; Add the following lines to your `.emacs' file:
 125 ;;
 126 ;;   (require 'rst)
 127 ;;
 128 ;; If you are using `.txt' as a standard extension for reST files as
 129 ;; http://docutils.sourceforge.net/FAQ.html#what-s-the-standard-filename-extension-for-a-restructuredtext-file
 130 ;; suggests you may use one of the `Local Variables in Files' mechanism Emacs
 131 ;; provides to set the major mode automatically.  For instance you may use::
 132 ;;
 133 ;;    .. -*- mode: rst -*-
 134 ;;
 135 ;; in the very first line of your file.  The following code is useful if you
 136 ;; want automatically enter rst-mode from any file with compatible extensions:
 137 ;;
 138 ;; (setq auto-mode-alist
 139 ;;       (append '(("\\.txt$" . rst-mode)
 140 ;;                 ("\\.rst$" . rst-mode)
 141 ;;                 ("\\.rest$" . rst-mode)) auto-mode-alist))
 142 ;;
 143
 144 ;;; BUGS
 145
 146 ;; - rst-enumeration-region: Select a single paragraph, with the top at one
 147 ;;   blank line before the beginning, and it will fail.
 148 ;; - The active region goes away when we shift it left or right, and this
 149 ;;   prevents us from refilling it automatically when shifting many times.
 150 ;; - The suggested decorations when adjusting should not have to cycle
 151 ;;   below one below the last section decoration level preceding the
 152 ;;   cursor.  We need to fix that.
 153
 154 ;;; TODO LIST
 155
 156 ;; rst-toc-insert features
 157 ;; ------------------------
 158 ;; - rst-toc-insert: We should parse the contents:: options to figure out how
 159 ;;   deep to render the inserted TOC.
 160 ;; - On load, detect any existing TOCs and set the properties for links.
 161 ;; - TOC insertion should have an option to add empty lines.
 162 ;; - TOC insertion should deal with multiple lines.
 163 ;; - There is a bug on redo after undo of adjust when rst-adjust-hook uses the
 164 ;;   automatic toc update.  The cursor ends up in the TOC and this is
 165 ;;   annoying.  Gotta fix that.
 166 ;; - numbering: automatically detect if we have a section-numbering directive in
 167 ;;   the corresponding section, to render the toc.
 168 ;;
 169 ;; bulleted and enumerated list items
 170 ;; ----------------------------------
 171 ;; - We need to provide way to rebullet bulleted lists, and that would include
 172 ;;   automatic enumeration as well.
 173 ;;
 174 ;; Other
 175 ;; -----
 176 ;; - It would be nice to differentiate between text files using
 177 ;;   reStructuredText_ and other general text files.  If we had a
 178 ;;   function to automatically guess whether a .txt file is following the
 179 ;;   reStructuredText_ conventions, we could trigger rst-mode without
 180 ;;   having to hard-code this in every text file, nor forcing the user to
 181 ;;   add a local mode variable at the top of the file.
 182 ;;   We could perform this guessing by searching for a valid decoration
 183 ;;   at the top of the document or searching for reStructuredText_
 184 ;;   directives further on.
 185 ;;
 186 ;; - We should support imenu in our major mode, with the menu filled with the
 187 ;;   section titles (this should be really easy).
 188 ;;
 189 ;; - We should rename "adornment" to "decoration" or vice-versa in this
 190 ;;   document (Stefan's code ("adornment") vs Martin ("decoration")), maybe some
 191 ;;   functions even overlap.
 192 ;;
 193 ;; - We need to automatically recenter on rst-forward-section movement commands.
 194
 195
 196 ;;; HISTORY
 197 ;;
 198
 199 ;;; Code:
 200
 201 \f
 202 (defgroup rst nil "Support for reStructuredText documents"
 203   :group 'wp
 204   :version "23.1"
 205   :link '(url-link "http://docutils.sourceforge.net/rst.html"))
 206
 207
 208
 209 \f
 210 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 211 ;; Define some generic support functions.
 212
 213 (eval-when-compile (require 'cl)) ;; We need this for destructuring-bind below.
 214
 215
 216 ;; From Emacs-22
 217 (unless (fboundp 'line-number-at-pos)
 218   (defun line-number-at-pos (&optional pos)
 219     "Return (narrowed) buffer line number at position POS.
 220     If POS is nil, use current buffer location."
 221     (let ((opoint (or pos (point))) start)
 222       (save-excursion
 223         (goto-char (point-min))
 224         (setq start (point))
 225         (goto-char opoint)
 226         (forward-line 0)
 227         (1+ (count-lines start (point)))))) )
 228
 229
 230 \f
 231 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 232 ;; Mode definition.
 233
 234 ;; Key bindings.
 235 (defvar rst-mode-map
 236   (let ((map (make-sparse-keymap)))
 237
 238     ;;
 239     ;; Section Decorations.
 240     ;;
 241     ;; The adjustment function that decorates or rotates a section title.
 242     (define-key map [(control c) (control a)] 'rst-adjust)
 243     (define-key map [(control c) (control ?=)] 'rst-adjust)
 244     (define-key map [(control ?=)] 'rst-adjust) ;; (Does not work on the Mac OSX.)
 245     ;; Display the hierarchy of decorations implied by the current document contents.
 246     (define-key map [(control c) (control h)] 'rst-display-decorations-hierarchy)
 247     ;; Homogeneize the decorations in the document.
 248     (define-key map [(control c) (control s)] 'rst-straighten-decorations)
 249 ;;    (define-key map [(control c) (control s)] 'rst-straighten-deco-spacing)
 250
 251     ;;
 252     ;; Section Movement and Selection.
 253     ;;
 254     ;; Mark the subsection where the cursor is.
 255     (define-key map [(control c) (control m)] 'rst-mark-section)
 256     ;; Move forward/backward between section titles.
 257     (define-key map [(control c) (control n)] 'rst-forward-section)
 258     (define-key map [(control c) (control p)] 'rst-backward-section)
 259
 260     ;;
 261     ;; Operating on Blocks of Text.
 262     ;;
 263     ;; Makes paragraphs in region as a bullet list.
 264     (define-key map [(control c) (control b)] 'rst-bullet-list-region)
 265     ;; Makes paragraphs in region as a enumeration.
 266     (define-key map [(control c) (control e)] 'rst-enumerate-region)
 267     ;; Converts bullets to an enumeration.
 268     (define-key map [(control c) (control v)] 'rst-convert-bullets-to-enumeration)
 269     ;; Makes region a line-block.
 270     (define-key map [(control c) (control d)] 'rst-line-block-region)
 271     ;; Make sure that all the bullets in the region are consistent.
 272     (define-key map [(control c) (control w)] 'rst-straighten-bullets-region)
 273     ;; Shift region left or right (taking into account of enumerations/bullets, etc.).
 274     (define-key map [(control c) (control l)] 'rst-shift-region-left)
 275     (define-key map [(control c) (control r)] 'rst-shift-region-right)
 276     ;; Comment/uncomment the active region.
 277     (define-key map [(control c) (control c)] 'comment-region)
 278
 279     ;;
 280     ;; Table-of-Contents Features.
 281     ;;
 282     ;; Enter a TOC buffer to view and move to a specific section.
 283     (define-key map [(control c) (control t)] 'rst-toc)
 284     ;; Insert a TOC here.
 285     (define-key map [(control c) (control i)] 'rst-toc-insert)
 286     ;; Update the document's TOC (without changing the cursor position).
 287     (define-key map [(control c) (control u)] 'rst-toc-update)
 288     ;; Got to the section under the cursor (cursor must be in TOC).
 289     (define-key map [(control c) (control f)] 'rst-goto-section)
 290
 291     ;;
 292     ;; Converting Documents from Emacs.
 293     ;;
 294     ;; Run one of two pre-configured toolset commands on the document.
 295     (define-key map [(control c) (?1)] 'rst-compile)
 296     (define-key map [(control c) (?2)] 'rst-compile-alt-toolset)
 297     ;; Convert the active region to pseudo-xml using the docutils tools.
 298     (define-key map [(control c) (?3)] 'rst-compile-pseudo-region)
 299     ;; Convert the current document to PDF and launch a viewer on the results.
 300     (define-key map [(control c) (?4)] 'rst-compile-pdf-preview)
 301     ;; Convert the current document to S5 slides and view in a web browser.
 302     (define-key map [(control c) (?5)] 'rst-compile-slides-preview)
 303
 304     map)
 305   "Keymap for ReStructuredText mode commands.
 306 This inherits from Text mode.")
 307
 308
 309 ;; Abbrevs.
 310 (defvar rst-mode-abbrev-table nil
 311   "Abbrev table used while in rst mode.")
 312 (define-abbrev-table 'rst-mode-abbrev-table
 313   '(
 314     ("contents" ".. contents::\n..\n   " nil 0)
 315     ("con" ".. contents::\n..\n   " nil 0)
 316     ("cont" "[...]" nil 0)
 317     ("skip" "\n\n[...]\n\n  " nil 0)
 318     ("seq" "\n\n[...]\n\n  " nil 0)
 319     ;; FIXME: Add footnotes, links, and more.
 320     ))
 321
 322
 323 ;; Syntax table.
 324 (defvar rst-mode-syntax-table
 325   (let ((st (copy-syntax-table text-mode-syntax-table)))
 326
 327     (modify-syntax-entry ?$ "." st)
 328     (modify-syntax-entry ?% "." st)
 329     (modify-syntax-entry ?& "." st)
 330     (modify-syntax-entry ?' "." st)
 331     (modify-syntax-entry ?* "." st)
 332     (modify-syntax-entry ?+ "." st)
 333     (modify-syntax-entry ?. "_" st)
 334     (modify-syntax-entry ?/ "." st)
 335     (modify-syntax-entry ?< "." st)
 336     (modify-syntax-entry ?= "." st)
 337     (modify-syntax-entry ?> "." st)
 338     (modify-syntax-entry ?\\ "\\" st)
 339     (modify-syntax-entry ?| "." st)
 340     (modify-syntax-entry ?_ "." st)
 341
 342     st)
 343   "Syntax table used while in `rst-mode'.")
 344
 345
 346 (defcustom rst-mode-hook nil
 347   "Hook run when Rst Mode is turned on.
 348 The hook for Text Mode is run before this one."
 349   :group 'rst
 350   :type '(hook))
 351
 352
 353 (defcustom rst-mode-lazy t
 354   "*If non-nil Rst Mode tries to font-lock multi-line elements correctly.
 355 Because this is really slow it should be set to nil if neither `jit-lock-mode'
 356 not `lazy-lock-mode' and activated.
 357
 358 If nil, comments and literal blocks are font-locked only on the line they start.
 359
 360 The value of this variable is used when Rst Mode is turned on."
 361   :group 'rst
 362   :type '(boolean))
 363
 364 ;; Use rst-mode for *.rst and *.rest files.  Many ReStructured-Text files
 365 ;; use *.txt, but this is too generic to be set as a default.
 366 ;;;###autoload (add-to-list 'auto-mode-alist '("\\.re?st\\'" . rst-mode))
 367 ;;;###autoload
 368 (define-derived-mode rst-mode text-mode "ReST"
 369   :abbrev-table rst-mode-abbrev-table
 370   :syntax-table rst-mode-syntax-table
 371   :group 'rst
 372   "Major mode for editing reStructuredText documents.
 373
 374 There are a number of convenient keybindings provided by
 375 rst-mode. The main one is \[rst-adjust\], it updates or rotates
 376 the section title around point or promotes/demotes the
 377 decorations within the region (see full details below). Use
 378 negative prefix arg to rotate in the other direction.
 379 \\{rst-mode-map}
 380
 381 Turning on `rst-mode' calls the normal hooks `text-mode-hook' and
 382 `rst-mode-hook'. This mode also supports font-lock highlighting.
 383 You may customize `rst-mode-lazy' to toggle font-locking of
 384 blocks."
 385
 386   (set (make-local-variable 'paragraph-separate) paragraph-start)
 387   (set (make-local-variable 'indent-line-function) 'indent-relative-maybe)
 388   (set (make-local-variable 'paragraph-start)
 389        "\f\\|>*[ \t]*$\\|>*[ \t]*[-+*] \\|>*[ \t]*[0-9#]+\\. ")
 390   (set (make-local-variable 'adaptive-fill-mode) t)
 391
 392   ;; FIXME: No need to reset this.
 393   ;; (set (make-local-variable 'indent-line-function) 'indent-relative)
 394
 395   ;; The details of the following comment setup is important because it affects
 396   ;; auto-fill, and it is pretty common in running text to have an ellipsis
 397   ;; ("...") which trips because of the rest comment syntax (".. ").
 398   (set (make-local-variable 'comment-start) ".. ")
 399   (set (make-local-variable 'comment-start-skip) "^\\.\\. ")
 400   (set (make-local-variable 'comment-multi-line) nil)
 401
 402   ;; Special variables
 403   (make-local-variable 'rst-adornment-level-alist)
 404
 405   ;; Font lock
 406   (set (make-local-variable 'font-lock-defaults)
 407        '(rst-font-lock-keywords-function
 408          t nil nil nil
 409          (font-lock-multiline . t)
 410          (font-lock-mark-block-function . mark-paragraph)))
 411   ;; `jit-lock-mode' has been the default since Emacs-21.1, so there's no
 412   ;; point messing around with font-lock-support-mode any more.
 413   ;; (when (boundp 'font-lock-support-mode)
 414   ;;   ;; rst-mode has its own mind about font-lock-support-mode
 415   ;;   (make-local-variable 'font-lock-support-mode)
 416   ;;   ;; jit-lock-mode replaced lazy-lock-mode in GNU Emacs 21.
 417   ;;   (let ((jit-or-lazy-lock-mode
 418   ;;          (cond
 419   ;;           ((fboundp 'lazy-lock-mode) 'lazy-lock-mode)
 420   ;;           ((fboundp 'jit-lock-mode) 'jit-lock-mode)
 421   ;;           ;; if neither lazy-lock nor jit-lock is supported,
 422   ;;           ;; tell user and disable rst-mode-lazy
 423   ;;           (t (when rst-mode-lazy
 424   ;;                (message "Disabled lazy fontification, because no known support mode found.")
 425   ;;                (setq rst-mode-lazy nil))))))
 426   ;;     (cond
 427   ;;      ((and (not rst-mode-lazy) (not font-lock-support-mode)))
 428   ;;      ;; No support mode set and none required - leave it alone
 429   ;;      ((or (not font-lock-support-mode) ;; No support mode set (but required)
 430   ;;           (symbolp font-lock-support-mode)) ;; or a fixed mode for all
 431   ;;       (setq font-lock-support-mode
 432   ;;             (list (cons 'rst-mode (and rst-mode-lazy jit-or-lazy-lock-mode))
 433   ;;                (cons t font-lock-support-mode))))
 434   ;;      ((and (listp font-lock-support-mode)
 435   ;;            (not (assoc 'rst-mode font-lock-support-mode)))
 436   ;;       ;; A list of modes missing rst-mode
 437   ;;       (setq font-lock-support-mode
 438   ;;             (cons (cons 'rst-mode (and rst-mode-lazy jit-or-lazy-lock-mode))
 439   ;;                font-lock-support-mode))))))
 440
 441   )
 442
 443
 444 ;;;###autoload
 445 (define-minor-mode rst-minor-mode
 446   "ReST Minor Mode.
 447 Toggle ReST minor mode.
 448 With no argument, this command toggles the mode.
 449 Non-null prefix argument turns on the mode.
 450 Null prefix argument turns off the mode.
 451
 452 When ReST minor mode is enabled, the ReST mode
 453 keybindings are installed on top of the major
 454 mode bindings. Use this for modes derived from
 455 text-mode, like mail-mode.."
 456  ;; The initial value.
 457  nil
 458  ;; The indicator for the mode line.
 459  " ReST"
 460  ;; The minor mode bindings.
 461  rst-mode-map
 462  :group 'rst)
 463
 464 ;; FIXME: can I somehow install these too?
 465 ;;  :abbrev-table rst-mode-abbrev-table
 466 ;;  :syntax-table rst-mode-syntax-table
 467
 468
 469
 470
 471 \f
 472 ;; Bulleted item lists.
 473 (defcustom rst-bullets
 474   '(?- ?* ?+)
 475   "List of all possible bullet characters for bulleted lists."
 476   :group 'rst)
 477
 478
 479
 480 \f
 481 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 482 ;; Section Decoration Adjusment
 483 ;; ============================
 484 ;;
 485 ;; The following functions implement a smart automatic title sectioning feature.
 486 ;; The idea is that with the cursor sitting on a section title, we try to get as
 487 ;; much information from context and try to do the best thing automatically.
 488 ;; This function can be invoked many times and/or with prefix argument to rotate
 489 ;; between the various sectioning decorations.
 490 ;;
 491 ;; Definitions: the two forms of sectioning define semantically separate section
 492 ;; levels.  A sectioning DECORATION consists in:
 493 ;;
 494 ;;   - a CHARACTER
 495 ;;
 496 ;;   - a STYLE which can be either of 'simple' or 'over-and-under'.
 497 ;;
 498 ;;   - an INDENT (meaningful for the over-and-under style only) which determines
 499 ;;     how many characters and over-and-under style is hanging outside of the
 500 ;;     title at the beginning and ending.
 501 ;;
 502 ;; Important note: an existing decoration must be formed by at least two
 503 ;; characters to be recognized.
 504 ;;
 505 ;; Here are two examples of decorations (| represents the window border, column
 506 ;; 0):
 507 ;;
 508 ;;                                  |
 509 ;; 1. char: '-'   e                 |Some Title
 510 ;;    style: simple                 |----------
 511 ;;                                  |
 512 ;; 2. char: '='                     |==============
 513 ;;    style: over-and-under         |  Some Title
 514 ;;    indent: 2                     |==============
 515 ;;                                  |
 516 ;;
 517 ;; Some notes:
 518 ;;
 519 ;; - The underlining character that is used depends on context. The file is
 520 ;;   scanned to find other sections and an appropriate character is selected.
 521 ;;   If the function is invoked on a section that is complete, the character is
 522 ;;   rotated among the existing section decorations.
 523 ;;
 524 ;;   Note that when rotating the characters, if we come to the end of the
 525 ;;   hierarchy of decorations, the variable rst-preferred-decorations is
 526 ;;   consulted to propose a new underline decoration, and if continued, we cycle
 527 ;;   the decorations all over again.  Set this variable to nil if you want to
 528 ;;   limit the underlining character propositions to the existing decorations in
 529 ;;   the file.
 530 ;;
 531 ;; - A prefix argument can be used to alternate the style.
 532 ;;
 533 ;; - An underline/overline that is not extended to the column at which it should
 534 ;;   be hanging is dubbed INCOMPLETE.  For example::
 535 ;;
 536 ;;      |Some Title
 537 ;;      |-------
 538 ;;
 539 ;; Examples of default invocation:
 540 ;;
 541 ;;   |Some Title       --->    |Some Title
 542 ;;   |                         |----------
 543 ;;
 544 ;;   |Some Title       --->    |Some Title
 545 ;;   |-----                    |----------
 546 ;;
 547 ;;   |                         |------------
 548 ;;   | Some Title      --->    | Some Title
 549 ;;   |                         |------------
 550 ;;
 551 ;; In over-and-under style, when alternating the style, a variable is
 552 ;; available to select how much default indent to use (it can be zero).  Note
 553 ;; that if the current section decoration already has an indent, we don't
 554 ;; adjust it to the default, we rather use the current indent that is already
 555 ;; there for adjustment (unless we cycle, in which case we use the indent
 556 ;; that has been found previously).
 557
 558 (defgroup rst-adjust nil
 559   "Settings for adjustment and cycling of section title
 560 decorations."
 561   :group 'rst
 562   :version "21.1")
 563
 564 (defcustom rst-preferred-decorations '( (?= over-and-under 1)
 565                                          (?= simple 0)
 566                                          (?- simple 0)
 567                                          (?~ simple 0)
 568                                          (?+ simple 0)
 569                                          (?` simple 0)
 570                                          (?# simple 0)
 571                                          (?@ simple 0) )
 572   "Preferred ordering of section title decorations.
 573
 574 This sequence is consulted to offer a new decoration suggestion
 575 when we rotate the underlines at the end of the existing
 576 hierarchy of characters, or when there is no existing section
 577 title in the file."
 578   :group 'rst-adjust)
 579
 580
 581 (defcustom rst-default-indent 1
 582   "Number of characters to indent the section title.
 583
 584 THis is used for when toggling decoration styles, when switching
 585 from a simple decoration style to a over-and-under decoration
 586 style."
 587   :group 'rst-adjust)
 588
 589
 590 (defvar rst-section-text-regexp "^[ \t]*\\S-*\\w\\S-*"
 591   "Regular expression for valid section title text.")
 592
 593
 594 (defun rst-line-homogeneous-p (&optional accept-special)
 595   "Return true if the line is homogeneous.
 596
 597 Predicate that returns the unique char if the current line is
 598 composed only of a single repeated non-whitespace character.  This
 599 returns the char even if there is whitespace at the beginning of
 600 the line.
 601
 602 If ACCEPT-SPECIAL is specified we do not ignore special sequences
 603 which normally we would ignore when doing a search on many lines.
 604 For example, normally we have cases to ignore commonly occuring
 605 patterns, such as :: or ...; with the flag do not ignore them."
 606   (save-excursion
 607     (back-to-indentation)
 608     (unless (looking-at "\n")
 609       (let ((c (thing-at-point 'char)))
 610         (if (and (looking-at (format "[%s]+[ \t]*$" c))
 611                  (or accept-special
 612                      (and
 613                       ;; Common patterns.
 614                       (not (looking-at "::[ \t]*$"))
 615                       (not (looking-at "\\.\\.\\.[ \t]*$"))
 616                       ;; Discard one char line
 617                       (not (looking-at ".[ \t]*$"))
 618                       )))
 619             (string-to-char c))
 620         ))
 621     ))
 622
 623 (defun rst-line-homogeneous-nodent-p (&optional accept-special)
 624   "Return true if the line is homogeneous with no indent.
 625 See `rst-line-homogeneous-p' about ACCEPT-SPECIAL."
 626   (save-excursion
 627     (beginning-of-line)
 628     (if (looking-at "^[ \t]+")
 629         nil
 630       (rst-line-homogeneous-p accept-special)
 631       )))
 632
 633
 634 (defun rst-compare-decorations (deco1 deco2)
 635   "Compare decorations.
 636 Returns true if both DECO1 and DECO2 decorations are equal,
 637 according to restructured text semantics (only the character and
 638 the style are compared, the indentation does not matter."
 639   (and (eq (car deco1) (car deco2))
 640        (eq (cadr deco1) (cadr deco2))))
 641
 642
 643 (defun rst-get-decoration-match (hier deco)
 644   "Return the index (level) in hierarchy HIER of decoration DECO.
 645 This basically just searches for the item using the appropriate
 646 comparison and returns the index.  We return nil if the item is
 647 not found."
 648   (let ((cur hier))
 649     (while (and cur (not (rst-compare-decorations (car cur) deco)))
 650       (setq cur (cdr cur)))
 651     cur))
 652
 653
 654 (defun rst-suggest-new-decoration (alldecos &optional prev)
 655   "Suggest a new, different decoration from all that have been seen.
 656
 657 ALLDECOS is the set of all decorations, including the line
 658 numbers.  PREV is the optional previous decoration, in order to
 659 suggest a better match."
 660
 661   ;; For all the preferred decorations...
 662   (let* (
 663          ;; If 'prev' is given, reorder the list to start searching after the
 664          ;; match.
 665          (fplist
 666           (cdr (rst-get-decoration-match rst-preferred-decorations prev)))
 667
 668          ;; List of candidates to search.
 669          (curpotential (append fplist rst-preferred-decorations)))
 670     (while
 671         ;; For all the decorations...
 672         (let ((cur alldecos)
 673               found)
 674           (while (and cur (not found))
 675             (if (rst-compare-decorations (car cur) (car curpotential))
 676                 ;; Found it!
 677                 (setq found (car curpotential))
 678               (setq cur (cdr cur))))
 679           found)
 680
 681       (setq curpotential (cdr curpotential)))
 682
 683     (copy-sequence (car curpotential))))
 684
 685 (defun rst-delete-entire-line ()
 686   "Delete the entire current line without using the `kill-ring'."
 687   (delete-region (line-beginning-position)
 688                  (line-beginning-position 2)))
 689
 690 (defun rst-update-section (char style &optional indent)
 691   "Unconditionally update the style of a section decoration.
 692
 693 Do this using the given character CHAR, with STYLE 'simple or
 694 'over-and-under, and with indent INDENT.  If the STYLE is
 695 'simple, whitespace before the title is removed (indent is always
 696 assume to be 0).
 697
 698 If there are existing overline and/or underline from the
 699 existing decoration, they are removed before adding the
 700 requested decoration."
 701
 702   (interactive)
 703   (let (marker
 704         len)
 705
 706       (end-of-line)
 707       (setq marker (point-marker))
 708
 709       ;; Fixup whitespace at the beginning and end of the line
 710       (if (or (null indent) (eq style 'simple))
 711           (setq indent 0))
 712       (beginning-of-line)
 713       (delete-horizontal-space)
 714       (insert (make-string indent ? ))
 715
 716       (end-of-line)
 717       (delete-horizontal-space)
 718
 719       ;; Set the current column, we're at the end of the title line
 720       (setq len (+ (current-column) indent))
 721
 722       ;; Remove previous line if it consists only of a single repeated character
 723       (save-excursion
 724         (forward-line -1)
 725         (and (rst-line-homogeneous-p 1)
 726              ;; Avoid removing the underline of a title right above us.
 727              (save-excursion (forward-line -1)
 728                              (not (looking-at rst-section-text-regexp)))
 729              (rst-delete-entire-line)))
 730
 731       ;; Remove following line if it consists only of a single repeated
 732       ;; character
 733       (save-excursion
 734         (forward-line +1)
 735         (and (rst-line-homogeneous-p 1)
 736              (rst-delete-entire-line))
 737         ;; Add a newline if we're at the end of the buffer, for the subsequence
 738         ;; inserting of the underline
 739         (if (= (point) (buffer-end 1))
 740             (newline 1)))
 741
 742       ;; Insert overline
 743       (if (eq style 'over-and-under)
 744           (save-excursion
 745             (beginning-of-line)
 746             (open-line 1)
 747             (insert (make-string len char))))
 748
 749       ;; Insert underline
 750       (forward-line +1)
 751       (open-line 1)
 752       (insert (make-string len char))
 753
 754       (forward-line +1)
 755       (goto-char marker)
 756       ))
 757
 758
 759 (defun rst-normalize-cursor-position ()
 760   "Normalize the cursor position.
 761 If the cursor is on a decoration line or an empty line , place it
 762 on the section title line (at the end).  Returns the line offset
 763 by which the cursor was moved.  This works both over or under a
 764 line."
 765   (if (save-excursion (beginning-of-line)
 766                       (or (rst-line-homogeneous-p 1)
 767                           (looking-at "^[ \t]*$")))
 768       (progn
 769         (beginning-of-line)
 770         (cond
 771          ((save-excursion (forward-line -1)
 772                           (beginning-of-line)
 773                           (and (looking-at rst-section-text-regexp)
 774                                (not (rst-line-homogeneous-p 1))))
 775           (progn (forward-line -1) -1))
 776          ((save-excursion (forward-line +1)
 777                           (beginning-of-line)
 778                           (and (looking-at rst-section-text-regexp)
 779                                (not (rst-line-homogeneous-p 1))))
 780           (progn (forward-line +1) +1))
 781          (t 0)))
 782     0 ))
 783
 784
 785 (defun rst-find-all-decorations ()
 786   "Find all the decorations in the file.
 787 Return a list of (line, decoration) pairs.  Each decoration
 788 consists in a (char, style, indent) triple.
 789
 790 This function does not detect the hierarchy of decorations, it
 791 just finds all of them in a file.  You can then invoke another
 792 function to remove redundancies and inconsistencies."
 793
 794   (let (positions
 795         (curline 1))
 796     ;; Iterate over all the section titles/decorations in the file.
 797     (save-excursion
 798       (goto-char (point-min))
 799       (while (< (point) (buffer-end 1))
 800         (if (rst-line-homogeneous-nodent-p)
 801             (progn
 802               (setq curline (+ curline (rst-normalize-cursor-position)))
 803
 804               ;; Here we have found a potential site for a decoration,
 805               ;; characterize it.
 806               (let ((deco (rst-get-decoration)))
 807                 (if (cadr deco) ;; Style is existing.
 808                     ;; Found a real decoration site.
 809                     (progn
 810                       (push (cons curline deco) positions)
 811                       ;; Push beyond the underline.
 812                       (forward-line 1)
 813                       (setq curline (+ curline 1))
 814                       )))
 815               ))
 816         (forward-line 1)
 817         (setq curline (+ curline 1))
 818         ))
 819     (reverse positions)))
 820
 821
 822 (defun rst-infer-hierarchy (decorations)
 823   "Build a hierarchy of decorations using the list of given DECORATIONS.
 824
 825 This function expects a list of (char, style, indent) decoration
 826 specifications, in order that they appear in a file, and will
 827 infer a hierarchy of section levels by removing decorations that
 828 have already been seen in a forward traversal of the decorations,
 829 comparing just the character and style.
 830
 831 Similarly returns a list of (char, style, indent), where each
 832 list element should be unique."
 833
 834   (let ((hierarchy-alist (list)))
 835     (dolist (x decorations)
 836       (let ((char (car x))
 837             (style (cadr x)))
 838         (unless (assoc (cons char style) hierarchy-alist)
 839           (push (cons (cons char style) x) hierarchy-alist))
 840         ))
 841
 842     (mapcar 'cdr (nreverse hierarchy-alist))
 843     ))
 844
 845
 846 (defun rst-get-hierarchy (&optional alldecos ignore)
 847   "Return the hierarchy of section titles in the file.
 848
 849 Return a list of decorations that represents the hierarchy of
 850 section titles in the file.  Reuse the list of decorations
 851 already computed in ALLDECOS if present.  If the line number in
 852 IGNORE is specified, the decoration found on that line (if there
 853 is one) is not taken into account when building the hierarchy."
 854   (let ((all (or alldecos (rst-find-all-decorations))))
 855     (setq all (assq-delete-all ignore all))
 856     (rst-infer-hierarchy (mapcar 'cdr all))))
 857
 858
 859 (defun rst-get-decoration (&optional point)
 860   "Get the decoration at POINT.
 861
 862 Looks around point and finds the characteristics of the
 863 decoration that is found there.  We assume that the cursor is
 864 already placed on the title line (and not on the overline or
 865 underline).
 866
 867 This function returns a (char, style, indent) triple.  If the
 868 characters of overline and underline are different, we return
 869 the underline character.  The indent is always calculated.  A
 870 decoration can be said to exist if the style is not nil.
 871
 872 A point can be specified to go to the given location before
 873 extracting the decoration."
 874
 875   (let (char style indent)
 876     (save-excursion
 877       (if point (goto-char point))
 878       (beginning-of-line)
 879       (if (looking-at rst-section-text-regexp)
 880           (let* ((over (save-excursion
 881                          (forward-line -1)
 882                          (rst-line-homogeneous-nodent-p)))
 883
 884                 (under (save-excursion
 885                          (forward-line +1)
 886                          (rst-line-homogeneous-nodent-p)))
 887                 )
 888
 889             ;; Check that the line above the overline is not part of a title
 890             ;; above it.
 891             (if (and over
 892                      (save-excursion
 893                        (and (equal (forward-line -2) 0)
 894                             (looking-at rst-section-text-regexp))))
 895                 (setq over nil))
 896
 897             (cond
 898              ;; No decoration found, leave all return values nil.
 899              ((and (eq over nil) (eq under nil)))
 900
 901              ;; Overline only, leave all return values nil.
 902              ;;
 903              ;; Note: we don't return the overline character, but it could
 904              ;; perhaps in some cases be used to do something.
 905              ((and over (eq under nil)))
 906
 907              ;; Underline only.
 908              ((and under (eq over nil))
 909               (setq char under
 910                     style 'simple))
 911
 912              ;; Both overline and underline.
 913              (t
 914               (setq char under
 915                     style 'over-and-under))
 916              )
 917             )
 918         )
 919       ;; Find indentation.
 920       (setq indent (save-excursion (back-to-indentation) (current-column)))
 921       )
 922     ;; Return values.
 923     (list char style indent)))
 924
 925
 926 (defun rst-get-decorations-around (&optional alldecos)
 927   "Return the decorations around point.
 928
 929 Given the list of all decorations ALLDECOS (with positions), find
 930 the decorations before and after the given point.  A list of the
 931 previous and next decorations is returned."
 932   (let* ((all (or alldecos (rst-find-all-decorations)))
 933          (curline (line-number-at-pos))
 934          prev next
 935          (cur all))
 936
 937     ;; Search for the decorations around the current line.
 938     (while (and cur (< (caar cur) curline))
 939       (setq prev cur
 940             cur (cdr cur)))
 941     ;; 'cur' is the following decoration.
 942
 943     (if (and cur (caar cur))
 944         (setq next (if (= curline (caar cur)) (cdr cur) cur)))
 945
 946     (mapcar 'cdar (list prev next))
 947     ))
 948
 949
 950 (defun rst-decoration-complete-p (deco)
 951   "Return true if the decoration DECO around POINT is complete."
 952   ;; Note: we assume that the detection of the overline as being the underline
 953   ;; of a preceding title has already been detected, and has been eliminated
 954   ;; from the decoration that is given to us.
 955
 956   ;; There is some sectioning already present, so check if the current
 957   ;; sectioning is complete and correct.
 958   (let* ((char (car deco))
 959          (style (cadr deco))
 960          (indent (caddr deco))
 961          (endcol (save-excursion (end-of-line) (current-column)))
 962          )
 963     (if char
 964         (let ((exps (concat "^"
 965                             (regexp-quote (make-string (+ endcol indent) char))
 966                             "$")))
 967           (and
 968            (save-excursion (forward-line +1)
 969                            (beginning-of-line)
 970                            (looking-at exps))
 971            (or (not (eq style 'over-and-under))
 972                (save-excursion (forward-line -1)
 973                                (beginning-of-line)
 974                                (looking-at exps))))
 975           ))
 976     ))
 977
 978
 979 (defun rst-get-next-decoration
 980   (curdeco hier &optional suggestion reverse-direction)
 981   "Get the next decoration for CURDECO, in given hierarchy HIER.
 982 If suggesting, suggest for new decoration SUGGESTION.
 983 REVERSE-DIRECTION is used to reverse the cycling order."
 984
 985   (let* (
 986          (char (car curdeco))
 987          (style (cadr curdeco))
 988
 989          ;; Build a new list of decorations for the rotation.
 990          (rotdecos
 991           (append hier
 992                   ;; Suggest a new decoration.
 993                   (list suggestion
 994                         ;; If nothing to suggest, use first decoration.
 995                         (car hier)))) )
 996     (or
 997      ;; Search for next decoration.
 998      (cadr
 999       (let ((cur (if reverse-direction rotdecos
1000                    (reverse rotdecos))))
1001         (while (and cur
1002                     (not (and (eq char (caar cur))
1003                               (eq style (cadar cur)))))
1004           (setq cur (cdr cur)))
1005         cur))
1006
1007      ;; If not found, take the first of all decorations.
1008      suggestion
1009      )))
1010
1011
1012 (defun rst-adjust ()
1013   "Auto-adjust the decoration around point.
1014
1015 Adjust/rotate the section decoration for the section title
1016 around point or promote/demote the decorations inside the region,
1017 depending on if the region is active.  This function is meant to
1018 be invoked possibly multiple times, and can vary its behaviour
1019 with a positive prefix argument (toggle style), or with a
1020 negative prefix argument (alternate behaviour).
1021
1022 This function is the main focus of this module and is a bit of a
1023 swiss knife.  It is meant as the single most essential function
1024 to be bound to invoke to adjust the decorations of a section
1025 title in restructuredtext.  It tries to deal with all the
1026 possible cases gracefully and to do `the right thing' in all
1027 cases.
1028
1029 See the documentations of `rst-adjust-decoration' and
1030 `rst-promote-region' for full details.
1031
1032 Prefix Arguments
1033 ================
1034
1035 The method can take either (but not both) of
1036
1037 a. a (non-negative) prefix argument, which means to toggle the
1038    decoration style.  Invoke with a prefix arg for example;
1039
1040 b. a negative numerical argument, which generally inverts the
1041    direction of search in the file or hierarchy.  Invoke with C--
1042    prefix for example."
1043   (interactive)
1044
1045   (let* (;; Save our original position on the current line.
1046          (origpt (set-marker (make-marker) (point)))
1047
1048          ;; Parse the positive and negative prefix arguments.
1049          (reverse-direction
1050           (and current-prefix-arg
1051                (< (prefix-numeric-value current-prefix-arg) 0)))
1052          (toggle-style
1053           (and current-prefix-arg (not reverse-direction))))
1054
1055     (if (rst-portable-mark-active-p)
1056         ;; Adjust decorations within region.
1057         (rst-promote-region current-prefix-arg)
1058       ;; Adjust decoration around point.
1059       (rst-adjust-decoration toggle-style reverse-direction))
1060
1061     ;; Run the hooks to run after adjusting.
1062     (run-hooks 'rst-adjust-hook)
1063
1064     ;; Make sure to reset the cursor position properly after we're done.
1065     (goto-char origpt)
1066
1067     ))
1068
1069 (defvar rst-adjust-hook nil
1070   "Hooks to be run after running `rst-adjust'.")
1071
1072 (defvar rst-new-decoration-down nil
1073   "Non-nil if new decoration is added deeper.
1074 If non-nil, a new decoration being added will be initialized to
1075 be one level down from the previous decoration.  If nil, a new
1076 decoration will be equal to the level of the previous
1077 decoration.")
1078
1079 (defun rst-adjust-decoration (&optional toggle-style reverse-direction)
1080 "Adjust/rotate the section decoration for the section title around point.
1081
1082 This function is meant to be invoked possibly multiple times, and
1083 can vary its behaviour with a true TOGGLE-STYLE argument, or with
1084 a REVERSE-DIRECTION argument.
1085
1086 General Behaviour
1087 =================
1088
1089 The next action it takes depends on context around the point, and
1090 it is meant to be invoked possibly more than once to rotate among
1091 the various possibilities.  Basically, this function deals with:
1092
1093 - adding a decoration if the title does not have one;
1094
1095 - adjusting the length of the underline characters to fit a
1096   modified title;
1097
1098 - rotating the decoration in the set of already existing
1099   sectioning decorations used in the file;
1100
1101 - switching between simple and over-and-under styles.
1102
1103 You should normally not have to read all the following, just
1104 invoke the method and it will do the most obvious thing that you
1105 would expect.
1106
1107
1108 Decoration Definitions
1109 ======================
1110
1111 The decorations consist in
1112
1113 1. a CHARACTER
1114
1115 2. a STYLE which can be either of 'simple' or 'over-and-under'.
1116
1117 3. an INDENT (meaningful for the over-and-under style only)
1118    which determines how many characters and over-and-under
1119    style is hanging outside of the title at the beginning and
1120    ending.
1121
1122 See source code for mode details.
1123
1124
1125 Detailed Behaviour Description
1126 ==============================
1127
1128 Here are the gory details of the algorithm (it seems quite
1129 complicated, but really, it does the most obvious thing in all
1130 the particular cases):
1131
1132 Before applying the decoration change, the cursor is placed on
1133 the closest line that could contain a section title.
1134
1135 Case 1: No Decoration
1136 ---------------------
1137
1138 If the current line has no decoration around it,
1139
1140 - search backwards for the last previous decoration, and apply
1141   the decoration one level lower to the current line.  If there
1142   is no defined level below this previous decoration, we suggest
1143   the most appropriate of the `rst-preferred-decorations'.
1144
1145   If REVERSE-DIRECTION is true, we simply use the previous
1146   decoration found directly.
1147
1148 - if there is no decoration found in the given direction, we use
1149   the first of `rst-preferred-decorations'.
1150
1151 The prefix argument forces a toggle of the prescribed decoration
1152 style.
1153
1154 Case 2: Incomplete Decoration
1155 -----------------------------
1156
1157 If the current line does have an existing decoration, but the
1158 decoration is incomplete, that is, the underline/overline does
1159 not extend to exactly the end of the title line (it is either too
1160 short or too long), we simply extend the length of the
1161 underlines/overlines to fit exactly the section title.
1162
1163 If the prefix argument is given, we toggle the style of the
1164 decoration as well.
1165
1166 REVERSE-DIRECTION has no effect in this case.
1167
1168 Case 3: Complete Existing Decoration
1169 ------------------------------------
1170
1171 If the decoration is complete (i.e. the underline (overline)
1172 length is already adjusted to the end of the title line), we
1173 search/parse the file to establish the hierarchy of all the
1174 decorations (making sure not to include the decoration around
1175 point), and we rotate the current title's decoration from within
1176 that list (by default, going *down* the hierarchy that is present
1177 in the file, i.e. to a lower section level).  This is meant to be
1178 used potentially multiple times, until the desired decoration is
1179 found around the title.
1180
1181 If we hit the boundary of the hierarchy, exactly one choice from
1182 the list of preferred decorations is suggested/chosen, the first
1183 of those decoration that has not been seen in the file yet (and
1184 not including the decoration around point), and the next
1185 invocation rolls over to the other end of the hierarchy (i.e. it
1186 cycles).  This allows you to avoid having to set which character
1187 to use by always using the
1188
1189 If REVERSE-DIRECTION is true, the effect is to change the
1190 direction of rotation in the hierarchy of decorations, thus
1191 instead going *up* the hierarchy.
1192
1193 However, if there is a non-negative prefix argument, we do not
1194 rotate the decoration, but instead simply toggle the style of the
1195 current decoration (this should be the most common way to toggle
1196 the style of an existing complete decoration).
1197
1198
1199 Point Location
1200 ==============
1201
1202 The invocation of this function can be carried out anywhere
1203 within the section title line, on an existing underline or
1204 overline, as well as on an empty line following a section title.
1205 This is meant to be as convenient as possible.
1206
1207
1208 Indented Sections
1209 =================
1210
1211 Indented section titles such as ::
1212
1213    My Title
1214    --------
1215
1216 are illegal in restructuredtext and thus not recognized by the
1217 parser.  This code will thus not work in a way that would support
1218 indented sections (it would be ambiguous anyway).
1219
1220
1221 Joint Sections
1222 ==============
1223
1224 Section titles that are right next to each other may not be
1225 treated well.  More work might be needed to support those, and
1226 special conditions on the completeness of existing decorations
1227 might be required to make it non-ambiguous.
1228
1229 For now we assume that the decorations are disjoint, that is,
1230 there is at least a single line between the titles/decoration
1231 lines.
1232
1233
1234 Suggested Binding
1235 =================
1236
1237 We suggest that you bind this function on C-=.  It is close to
1238 C-- so a negative argument can be easily specified with a flick
1239 of the right hand fingers and the binding is unused in `text-mode'."
1240   (interactive)
1241
1242   ;; If we were invoked directly, parse the prefix arguments into the
1243   ;; arguments of the function.
1244   (if current-prefix-arg
1245       (setq reverse-direction
1246             (and current-prefix-arg
1247                  (< (prefix-numeric-value current-prefix-arg) 0))
1248
1249             toggle-style
1250             (and current-prefix-arg (not reverse-direction))))
1251
1252   (let* (;; Check if we're on an underline around a section title, and move the
1253          ;; cursor to the title if this is the case.
1254          (moved (rst-normalize-cursor-position))
1255
1256          ;; Find the decoration and completeness around point.
1257          (curdeco (rst-get-decoration))
1258          (char (car curdeco))
1259          (style (cadr curdeco))
1260          (indent (caddr curdeco))
1261
1262          ;; New values to be computed.
1263          char-new style-new indent-new
1264          )
1265
1266     ;; We've moved the cursor... if we're not looking at some text, we have
1267     ;; nothing to do.
1268     (if (save-excursion (beginning-of-line)
1269                         (looking-at rst-section-text-regexp))
1270         (progn
1271           (cond
1272            ;;-------------------------------------------------------------------
1273            ;; Case 1: No Decoration
1274            ((and (eq char nil) (eq style nil))
1275
1276             (let* ((alldecos (rst-find-all-decorations))
1277
1278                    (around (rst-get-decorations-around alldecos))
1279                    (prev (car around))
1280                    cur
1281
1282                    (hier (rst-get-hierarchy alldecos))
1283                    )
1284
1285               ;; Advance one level down.
1286               (setq cur
1287                     (if prev
1288                         (if (not reverse-direction)
1289                             (or (funcall (if rst-new-decoration-down 'cadr 'car)
1290                                          (rst-get-decoration-match hier prev))
1291                                 (rst-suggest-new-decoration hier prev))
1292                           prev)
1293                       (copy-sequence (car rst-preferred-decorations))))
1294
1295               ;; Invert the style if requested.
1296               (if toggle-style
1297                   (setcar (cdr cur) (if (eq (cadr cur) 'simple)
1298                                         'over-and-under 'simple)) )
1299
1300               (setq char-new (car cur)
1301                     style-new (cadr cur)
1302                     indent-new (caddr cur))
1303               ))
1304
1305            ;;-------------------------------------------------------------------
1306            ;; Case 2: Incomplete Decoration
1307            ((not (rst-decoration-complete-p curdeco))
1308
1309             ;; Invert the style if requested.
1310             (if toggle-style
1311                 (setq style (if (eq style 'simple) 'over-and-under 'simple)))
1312
1313             (setq char-new char
1314                   style-new style
1315                   indent-new indent))
1316
1317            ;;-------------------------------------------------------------------
1318            ;; Case 3: Complete Existing Decoration
1319            (t
1320             (if toggle-style
1321
1322                 ;; Simply switch the style of the current decoration.
1323                 (setq char-new char
1324                       style-new (if (eq style 'simple) 'over-and-under 'simple)
1325                       indent-new rst-default-indent)
1326
1327               ;; Else, we rotate, ignoring the decoration around the current
1328               ;; line...
1329               (let* ((alldecos (rst-find-all-decorations))
1330
1331                      (hier (rst-get-hierarchy alldecos (line-number-at-pos)))
1332
1333                      ;; Suggestion, in case we need to come up with something
1334                      ;; new
1335                      (suggestion (rst-suggest-new-decoration
1336                                   hier
1337                                   (car (rst-get-decorations-around alldecos))))
1338
1339                      (nextdeco (rst-get-next-decoration
1340                                 curdeco hier suggestion reverse-direction))
1341
1342                      )
1343
1344                 ;; Indent, if present, always overrides the prescribed indent.
1345                 (setq char-new (car nextdeco)
1346                       style-new (cadr nextdeco)
1347                       indent-new (caddr nextdeco))
1348
1349                 )))
1350            )
1351
1352           ;; Override indent with present indent!
1353           (setq indent-new (if (> indent 0) indent indent-new))
1354
1355           (if (and char-new style-new)
1356               (rst-update-section char-new style-new indent-new))
1357           ))
1358
1359
1360     ;; Correct the position of the cursor to more accurately reflect where it
1361     ;; was located when the function was invoked.
1362     (unless (= moved 0)
1363       (forward-line (- moved))
1364       (end-of-line))
1365
1366     ))
1367
1368 ;; Maintain an alias for compatibility.
1369 (defalias 'rst-adjust-section-title 'rst-adjust)
1370
1371
1372 (defun rst-promote-region (&optional demote)
1373   "Promote the section titles within the region.
1374
1375 With argument DEMOTE or a prefix argument, demote the
1376 section titles instead.  The algorithm used at the boundaries of
1377 the hierarchy is similar to that used by `rst-adjust-decoration'."
1378   (interactive)
1379
1380   (let* ((demote (or current-prefix-arg demote))
1381          (alldecos (rst-find-all-decorations))
1382          (cur alldecos)
1383
1384          (hier (rst-get-hierarchy alldecos))
1385          (suggestion (rst-suggest-new-decoration hier))
1386
1387          (region-begin-line (line-number-at-pos (region-beginning)))
1388          (region-end-line (line-number-at-pos (region-end)))
1389
1390          marker-list
1391          )
1392
1393     ;; Skip the markers that come before the region beginning
1394     (while (and cur (< (caar cur) region-begin-line))
1395       (setq cur (cdr cur)))
1396
1397     ;; Create a list of markers for all the decorations which are found within
1398     ;; the region.
1399     (save-excursion
1400       (let (m line)
1401         (while (and cur (< (setq line (caar cur)) region-end-line))
1402           (setq m (make-marker))
1403           (goto-line line)
1404           (push (list (set-marker m (point)) (cdar cur)) marker-list)
1405           (setq cur (cdr cur)) ))
1406
1407       ;; Apply modifications.
1408       (let (nextdeco)
1409         (dolist (p marker-list)
1410           ;; Go to the decoration to promote.
1411           (goto-char (car p))
1412
1413           ;; Rotate the next decoration.
1414           (setq nextdeco (rst-get-next-decoration
1415                           (cadr p) hier suggestion demote))
1416
1417           ;; Update the decoration.
1418           (apply 'rst-update-section nextdeco)
1419
1420           ;; Clear marker to avoid slowing down the editing after we're done.
1421           (set-marker (car p) nil)
1422           ))
1423       (setq deactivate-mark nil)
1424     )))
1425
1426
1427
1428 (defun rst-display-decorations-hierarchy (&optional decorations)
1429   "Display the current file's section title decorations hierarchy.
1430 This function expects a list of (char, style, indent) triples in
1431 DECORATIONS."
1432   (interactive)
1433
1434   (if (not decorations)
1435       (setq decorations (rst-get-hierarchy)))
1436   (with-output-to-temp-buffer "*rest section hierarchy*"
1437     (let ((level 1))
1438       (with-current-buffer standard-output
1439         (dolist (x decorations)
1440           (insert (format "\nSection Level %d" level))
1441           (apply 'rst-update-section x)
1442           (goto-char (point-max))
1443           (insert "\n")
1444           (incf level)
1445           ))
1446     )))
1447
1448 (defun rst-position (elem list)
1449   "Return position of ELEM in LIST or nil."
1450   (let ((tail (member elem list)))
1451     (if tail (- (length list) (length tail)))))
1452
1453 (defun rst-straighten-decorations ()
1454   "Redo all the decorations in the current buffer.
1455 This is done using our preferred set of decorations.  This can be
1456 used, for example, when using somebody else's copy of a document,
1457 in order to adapt it to our preferred style."
1458   (interactive)
1459   (save-excursion
1460     (let* ((alldecos (rst-find-all-decorations))
1461            (hier (rst-get-hierarchy alldecos))
1462
1463            ;; Get a list of pairs of (level . marker)
1464            (levels-and-markers (mapcar
1465                                 (lambda (deco)
1466                                   (cons (rst-position (cdr deco) hier)
1467                                         (let ((m (make-marker)))
1468                                           (goto-line (car deco))
1469                                           (set-marker m (point))
1470                                           m)))
1471                                 alldecos))
1472            )
1473       (dolist (lm levels-and-markers)
1474         ;; Go to the appropriate position
1475         (goto-char (cdr lm))
1476
1477         ;; Apply the new styule
1478         (apply 'rst-update-section (nth (car lm) rst-preferred-decorations))
1479
1480         ;; Reset the market to avoid slowing down editing until it gets GC'ed
1481         (set-marker (cdr lm) nil)
1482         )
1483     )))
1484
1485
1486
1487
1488 (defun rst-straighten-deco-spacing ()
1489   "Adjust the spacing before and after decorations in the entire document.
1490 The spacing will be set to two blank lines before the first two
1491 section levels, and one blank line before any of the other
1492 section levels."
1493 ;; FIXME: we need to take care of subtitle at some point.
1494   (interactive)
1495   (save-excursion
1496     (let* ((alldecos (rst-find-all-decorations)))
1497
1498       ;; Work the list from the end, so that we don't have to use markers to
1499       ;; adjust for the changes in the document.
1500       (dolist (deco (nreverse alldecos))
1501         ;; Go to the appropriate position.
1502         (goto-line (car deco))
1503         (insert "@\n")
1504 ;; FIXME: todo, we
1505         )
1506     )))
1507
1508
1509 (defun rst-find-pfx-in-region (beg end pfx-re)
1510   "Find all the positions of prefixes in region between BEG and END.
1511 This is used to find bullets and enumerated list items.  PFX-RE
1512 is a regular expression for matching the lines with items."
1513   (let (pfx)
1514     (save-excursion
1515       (goto-char beg)
1516       (while (< (point) end)
1517         (back-to-indentation)
1518         (when (and
1519                (looking-at pfx-re)
1520                (let ((pfx-col (current-column)))
1521                  (save-excursion
1522                    (forward-line -1)
1523                    (back-to-indentation)
1524                    (or (looking-at "^[ \t]*$")
1525                        (> (current-column) pfx-col)
1526                        (and (= (current-column) pfx-col)
1527                             (looking-at pfx-re))))))
1528           (push (cons (point) (current-column))
1529                 pfx))
1530         (forward-line 1)) )
1531     (nreverse pfx)))
1532
1533 (defvar rst-re-bullets
1534   (format "\\([%s][ \t]\\)[^ \t]" (regexp-quote (concat rst-bullets)))
1535   "Regexp for finding bullets.")
1536
1537 (defvar rst-re-enumerations
1538   "\\(\\(#\\|[0-9]+\\)\\.[ \t]\\)[^ \t]"
1539   "Regexp for finding bullets.")
1540
1541 (defvar rst-re-items
1542   (format "\\(%s\\|%s\\)[^ \t]"
1543           (format "[%s][ \t]" (regexp-quote (concat rst-bullets)))
1544           "\\(#\\|[0-9]+\\)\\.[ \t]")
1545   "Regexp for finding bullets.")
1546
1547 (defvar rst-preferred-bullets
1548   '(?- ?* ?+)
1549   "List of favourite bullets to set for straightening bullets.")
1550
1551 (defun rst-straighten-bullets-region (beg end)
1552   "Make all the bulleted list items in the region consistent.
1553 The region is specified between BEG and END.  You can use this
1554 after you have merged multiple bulleted lists to make them use
1555 the same/correct/consistent bullet characters.
1556
1557 See variable `rst-preferred-bullets' for the list of bullets to
1558 adjust.  If bullets are found on levels beyond the
1559 `rst-preferred-bullets' list, they are not modified."
1560   (interactive "r")
1561
1562   (let ((bullets (rst-find-pfx-in-region beg end
1563                                          rst-re-bullets))
1564         (levtable (make-hash-table :size 4)))
1565
1566     ;; Create a map of levels to list of positions.
1567     (dolist (x bullets)
1568       (let ((key (cdr x)))
1569         (puthash key
1570                   (append (gethash key levtable (list))
1571                           (list (car x)))
1572                   levtable)))
1573
1574     ;; Sort this map and create a new map of prefix char and list of positions.
1575     (let ((poslist ()))                 ; List of (indent . positions).
1576       (maphash (lambda (x y) (push (cons x y) poslist)) levtable)
1577
1578       (let ((bullets rst-preferred-bullets))
1579         (dolist (x (sort poslist 'car-less-than-car))
1580           (when bullets
1581             ;; Apply the characters.
1582             (dolist (pos (cdr x))
1583               (goto-char pos)
1584               (delete-char 1)
1585               (insert (string (car bullets))))
1586             (setq bullets (cdr bullets))))))))
1587
1588 (defun rst-rstrip (str)
1589   "Strips the whitespace at the end of string STR."
1590   (string-match "[ \t\n]*\\'" str)
1591   (substring str 0 (match-beginning 0)))
1592
1593 (defun rst-get-stripped-line ()
1594   "Return the line at cursor, stripped from whitespace."
1595   (re-search-forward "\\S-.*\\S-" (line-end-position))
1596   (buffer-substring-no-properties (match-beginning 0)
1597                                   (match-end 0)) )
1598
1599 (defun rst-section-tree (alldecos)
1600   "Get the hierarchical tree of section titles.
1601
1602 Returns a hierarchical tree of the sections titles in the
1603 document, for decorations ALLDECOS.  This can be used to generate
1604 a table of contents for the document.  The top node will always
1605 be a nil node, with the top level titles as children (there may
1606 potentially be more than one).
1607
1608 Each section title consists in a cons of the stripped title
1609 string and a marker to the section in the original text document.
1610
1611 If there are missing section levels, the section titles are
1612 inserted automatically, and the title string is set to nil, and
1613 the marker set to the first non-nil child of itself.
1614 Conceptually, the nil nodes--i.e.  those which have no title--are
1615 to be considered as being the same line as their first non-nil
1616 child.  This has advantages later in processing the graph."
1617
1618   (let* ((hier (rst-get-hierarchy alldecos))
1619          (levels (make-hash-table :test 'equal :size 10))
1620          lines)
1621
1622     (let ((lev 0))
1623       (dolist (deco hier)
1624         ;; Compare just the character and indent in the hash table.
1625         (puthash (cons (car deco) (cadr deco)) lev levels)
1626         (incf lev)))
1627
1628     ;; Create a list of lines that contains (text, level, marker) for each
1629     ;; decoration.
1630     (save-excursion
1631       (setq lines
1632             (mapcar (lambda (deco)
1633                       (goto-line (car deco))
1634                       (list (gethash (cons (cadr deco) (caddr deco)) levels)
1635                             (rst-get-stripped-line)
1636                             (let ((m (make-marker)))
1637                               (beginning-of-line 1)
1638                               (set-marker m (point)))
1639                             ))
1640                     alldecos)))
1641
1642     (let ((lcontnr (cons nil lines)))
1643       (rst-section-tree-rec lcontnr -1))))
1644
1645
1646 (defun rst-section-tree-rec (decos lev)
1647   "Recursive guts of the section tree construction.
1648 DECOS is a cons cell whose cdr is the remaining list of
1649 decorations, and we change it as we consume them.  LEV is the
1650 current level of that node.  This function returns a pair of the
1651 subtree that was built.  This treats the decos list
1652 destructively."
1653
1654   (let ((ndeco (cadr decos))
1655         node
1656         children)
1657
1658     ;; If the next decoration matches our level
1659     (when (and ndeco (= (car ndeco) lev))
1660       ;; Pop the next decoration and create the current node with it
1661       (setcdr decos (cddr decos))
1662       (setq node (cdr ndeco)) )
1663     ;; Else we let the node title/marker be unset.
1664
1665     ;; Build the child nodes
1666     (while (and (cdr decos) (> (caadr decos) lev))
1667       (setq children
1668             (cons (rst-section-tree-rec decos (1+ lev))
1669                   children)))
1670     (setq children (reverse children))
1671
1672     ;; If node is still unset, we use the marker of the first child.
1673     (when (eq node nil)
1674       (setq node (cons nil (cdaar children))))
1675
1676     ;; Return this node with its children.
1677     (cons node children)
1678     ))
1679
1680
1681 (defun rst-section-tree-point (node &optional point)
1682   "Find tree node at point.
1683 Given a computed and valid section tree in NODE and a point
1684 POINT (default being the current point in the current buffer),
1685 find and return the node within the sectree where the cursor
1686 lives.
1687
1688 Return values: a pair of (parent path, container subtree).  The
1689 parent path is simply a list of the nodes above the container
1690 subtree node that we're returning."
1691
1692   (let (path outtree)
1693
1694     (let* ((curpoint (or point (point))))
1695
1696       ;; Check if we are before the current node.
1697       (if (and (cadar node) (>= curpoint (cadar node)))
1698
1699           ;; Iterate all the children, looking for one that might contain the
1700           ;; current section.
1701           (let ((curnode (cdr node))
1702                 last)
1703
1704             (while (and curnode (>= curpoint (cadaar curnode)))
1705               (setq last curnode
1706                     curnode (cdr curnode)))
1707
1708             (if last
1709                 (let ((sub (rst-section-tree-point (car last) curpoint)))
1710                   (setq path (car sub)
1711                         outtree (cdr sub)))
1712               (setq outtree node))
1713
1714             )))
1715     (cons (cons (car node) path) outtree)
1716     ))
1717
1718
1719 (defgroup rst-toc nil
1720   "Settings for reStructuredText table of contents."
1721   :group 'rst
1722   :version "21.1")
1723
1724 (defcustom rst-toc-indent 2
1725   "Indentation for table-of-contents display.
1726 Also used for formatting insertion, when numbering is disabled."
1727   :group 'rst-toc)
1728
1729 (defcustom rst-toc-insert-style 'fixed
1730   "Insertion style for table-of-contents.
1731 Set this to one of the following values to determine numbering and
1732 indentation style:
1733 - plain: no numbering (fixed indentation)
1734 - fixed: numbering, but fixed indentation
1735 - aligned: numbering, titles aligned under each other
1736 - listed: numbering, with dashes like list items (EXPERIMENTAL)"
1737   :group 'rst-toc)
1738
1739 (defcustom rst-toc-insert-number-separator "  "
1740   "Separator that goes between the TOC number and the title."
1741   :group 'rst-toc)
1742
1743 ;; This is used to avoid having to change the user's mode.
1744 (defvar rst-toc-insert-click-keymap
1745   (let ((map (make-sparse-keymap)))
1746        (define-key map [mouse-1] 'rst-toc-mode-mouse-goto)
1747        map)
1748   "(Internal) What happens when you click on propertized text in the TOC.")
1749
1750 (defcustom rst-toc-insert-max-level nil
1751   "If non-nil, maximum depth of the inserted TOC."
1752   :group 'rst-toc)
1753
1754
1755 (defun rst-toc-insert (&optional pfxarg)
1756   "Insert a simple text rendering of the table of contents.
1757 By default the top level is ignored if there is only one, because
1758 we assume that the document will have a single title.
1759
1760 If a numeric prefix argument PFXARG is given, insert the TOC up
1761 to the specified level.
1762
1763 The TOC is inserted indented at the current column."
1764
1765   (interactive "P")
1766
1767   (let* (;; Check maximum level override
1768          (rst-toc-insert-max-level
1769           (if (and (integerp pfxarg) (> (prefix-numeric-value pfxarg) 0))
1770               (prefix-numeric-value pfxarg) rst-toc-insert-max-level))
1771
1772          ;; Get the section tree for the current cursor point.
1773          (sectree-pair
1774           (rst-section-tree-point
1775            (rst-section-tree (rst-find-all-decorations))))
1776
1777          ;; Figure out initial indent.
1778          (initial-indent (make-string (current-column) ? ))
1779          (init-point (point)))
1780
1781     (when (cddr sectree-pair)
1782       (rst-toc-insert-node (cdr sectree-pair) 0 initial-indent "")
1783
1784       ;; Fixup for the first line.
1785       (delete-region init-point (+ init-point (length initial-indent)))
1786
1787       ;; Delete the last newline added.
1788       (delete-backward-char 1)
1789     )))
1790
1791 (defun rst-toc-insert-node (node level indent pfx)
1792   "Insert tree node NODE in table-of-contents.
1793 Recursive function that does printing of the inserted toc.  LEVEL
1794 is the depth level of the sections in the tree.  INDENT bis the
1795 indentation string.  PFX is the prefix numbering, that includes
1796 the alignment necessary for all the children of level to
1797 align."
1798
1799   ;; Note: we do child numbering from the parent, so we start number the
1800   ;; children one level before we print them.
1801   (let ((do-print (> level 0))
1802         (count 1))
1803     (when do-print
1804       (insert indent)
1805       (let ((b (point)))
1806         (unless (equal rst-toc-insert-style 'plain)
1807           (insert pfx rst-toc-insert-number-separator))
1808         (insert (or (caar node) "[missing node]"))
1809         ;; Add properties to the text, even though in normal text mode it
1810         ;; won't be doing anything for now.  Not sure that I want to change
1811         ;; mode stuff.  At least the highlighting gives the idea that this
1812         ;; is generated automatically.
1813         (put-text-property b (point) 'mouse-face 'highlight)
1814         (put-text-property b (point) 'rst-toc-target (cadar node))
1815         (put-text-property b (point) 'keymap rst-toc-insert-click-keymap)
1816
1817         )
1818       (insert "\n")
1819
1820       ;; Prepare indent for children.
1821       (setq indent
1822             (cond
1823              ((eq rst-toc-insert-style 'plain)
1824               (concat indent (make-string rst-toc-indent ? )))
1825
1826              ((eq rst-toc-insert-style 'fixed)
1827               (concat indent (make-string rst-toc-indent ? )))
1828
1829              ((eq rst-toc-insert-style 'aligned)
1830               (concat indent (make-string (+ (length pfx) 2) ? )))
1831
1832              ((eq rst-toc-insert-style 'listed)
1833               (concat (substring indent 0 -3)
1834                       (concat (make-string (+ (length pfx) 2) ? ) " - ")))
1835              ))
1836       )
1837
1838     (if (or (eq rst-toc-insert-max-level nil)
1839             (< level rst-toc-insert-max-level))
1840         (let ((do-child-numbering (>= level 0))
1841               fmt)
1842           (if do-child-numbering
1843               (progn
1844                 ;; Add a separating dot if there is already a prefix
1845                 (if (> (length pfx) 0)
1846                     (setq pfx (concat (rst-rstrip pfx) ".")))
1847
1848                 ;; Calculate the amount of space that the prefix will require
1849                 ;; for the numbers.
1850                 (if (cdr node)
1851                     (setq fmt (format "%%-%dd"
1852                                       (1+ (floor (log10 (length
1853                                                          (cdr node))))))))
1854                 ))
1855
1856           (dolist (child (cdr node))
1857             (rst-toc-insert-node child
1858                                  (1+ level)
1859                                  indent
1860                                  (if do-child-numbering
1861                                      (concat pfx (format fmt count)) pfx))
1862             (incf count)))
1863
1864       )))
1865
1866
1867 (defun rst-toc-insert-find-delete-contents ()
1868   "Find and deletes an existing comment after the first contents directive.
1869 Delete that region.  Return t if found and the cursor is left after the comment."
1870   (goto-char (point-min))
1871   ;; We look for the following and the following only (in other words, if your
1872   ;; syntax differs, this won't work.  If you would like a more flexible thing,
1873   ;; contact the author, I just can't imagine that this requirement is
1874   ;; unreasonable for now).
1875   ;;
1876   ;;   .. contents:: [...anything here...]
1877   ;;   ..
1878   ;;      XXXXXXXX
1879   ;;      XXXXXXXX
1880   ;;      [more lines]
1881   ;;
1882   (let ((beg
1883          (re-search-forward "^\\.\\. contents[ \t]*::\\(.*\\)\n\\.\\."
1884                             nil t))
1885         last-real)
1886     (when beg
1887       ;; Look for the first line that starts at the first column.
1888       (forward-line 1)
1889       (beginning-of-line)
1890       (while (and
1891               (< (point) (point-max))
1892               (or (and (looking-at "[ \t]+[^ \t]") (setq last-real (point)) t)
1893                   (looking-at "[ \t]*$")))
1894         (forward-line 1)
1895         )
1896       (if last-real
1897           (progn
1898             (goto-char last-real)
1899             (end-of-line)
1900             (delete-region beg (point)))
1901         (goto-char beg))
1902       t
1903       )))
1904
1905 (defun rst-toc-update ()
1906   "Automatically find the contents section of a document and update.
1907 Updates the inserted TOC if present.  You can use this in your
1908 file-write hook to always make it up-to-date automatically."
1909   (interactive)
1910   (let ((p (point)))
1911     (save-excursion
1912       (when (rst-toc-insert-find-delete-contents)
1913         (insert "\n    ")
1914         (rst-toc-insert)
1915         ))
1916     ;; Somehow save-excursion does not really work well.
1917     (goto-char p))
1918   ;; Note: always return nil, because this may be used as a hook.
1919   )
1920
1921 ;; Note: we cannot bind the TOC update on file write because it messes with
1922 ;; undo.  If we disable undo, since it adds and removes characters, the
1923 ;; positions in the undo list are not making sense anymore.  Dunno what to do
1924 ;; with this, it would be nice to update when saving.
1925 ;;
1926 ;; (add-hook 'write-contents-hooks 'rst-toc-update-fun)
1927 ;; (defun rst-toc-update-fun ()
1928 ;;   ;; Disable undo for the write file hook.
1929 ;;   (let ((buffer-undo-list t)) (rst-toc-update) ))
1930
1931 (defalias 'rst-toc-insert-update 'rst-toc-update) ;; backwards compat.
1932
1933 ;;------------------------------------------------------------------------------
1934
1935 (defun rst-toc-node (node level)
1936   "Recursive function that does insert NODE at LEVEL in the table-of-contents."
1937
1938   (if (> level 0)
1939       (let ((b (point)))
1940         ;; Insert line text.
1941         (insert (make-string (* rst-toc-indent (1- level)) ? ))
1942         (insert (or (caar node) "[missing node]"))
1943
1944         ;; Highlight lines.
1945         (put-text-property b (point) 'mouse-face 'highlight)
1946
1947         ;; Add link on lines.
1948         (put-text-property b (point) 'rst-toc-target (cadar node))
1949
1950         (insert "\n")
1951         ))
1952
1953   (dolist (child (cdr node))
1954     (rst-toc-node child (1+ level))))
1955
1956 (defun rst-toc-count-lines (node target-node)
1957   "Count the number of lines from NODE to the TARGET-NODE node.
1958 This recursive function returns a cons of the number of
1959 additional lines that have been counted for its node and children
1960 and 't if the node has been found."
1961
1962   (let ((count 1)
1963         found)
1964     (if (eq node target-node)
1965         (setq found t)
1966       (let ((child (cdr node)))
1967         (while (and child (not found))
1968           (let ((cl (rst-toc-count-lines (car child) target-node)))
1969             (setq count (+ count (car cl))
1970                   found (cdr cl)
1971                   child (cdr child))))))
1972     (cons count found)))
1973
1974 (defvar rst-toc-buffer-name "*Table of Contents*"
1975   "Name of the Table of Contents buffer.")
1976
1977 (defvar rst-toc-return-buffer nil
1978   "Buffer to which to return when leaving the TOC.")
1979
1980
1981 (defun rst-toc ()
1982   "Display a table-of-contents.
1983 Finds all the section titles and their decorations in the
1984 file, and displays a hierarchically-organized list of the
1985 titles, which is essentially a table-of-contents of the
1986 document.
1987
1988 The Emacs buffer can be navigated, and selecting a section
1989 brings the cursor in that section."
1990   (interactive)
1991   (let* ((curbuf (current-buffer))
1992
1993          ;; Get the section tree
1994          (alldecos (rst-find-all-decorations))
1995          (sectree (rst-section-tree alldecos))
1996
1997          (our-node (cdr (rst-section-tree-point sectree)))
1998          line
1999
2000          ;; Create a temporary buffer.
2001          (buf (get-buffer-create rst-toc-buffer-name))
2002          )
2003
2004     (with-current-buffer buf
2005       (let ((inhibit-read-only t))
2006         (rst-toc-mode)
2007         (delete-region (point-min) (point-max))
2008         (insert (format "Table of Contents: %s\n" (or (caar sectree) "")))
2009         (put-text-property (point-min) (point)
2010                            'face (list '(background-color . "gray")))
2011         (rst-toc-node sectree 0)
2012
2013         ;; Count the lines to our found node.
2014         (let ((linefound (rst-toc-count-lines sectree our-node)))
2015           (setq line (if (cdr linefound) (car linefound) 0)))
2016         ))
2017     (display-buffer buf)
2018     (pop-to-buffer buf)
2019
2020     ;; Save the buffer to return to.
2021     (set (make-local-variable 'rst-toc-return-buffer) curbuf)
2022
2023     ;; Move the cursor near the right section in the TOC.
2024     (goto-line line)
2025     ))
2026
2027
2028 (defun rst-toc-mode-find-section ()
2029   "Get the section from text property at point."
2030   (let ((pos (get-text-property (point) 'rst-toc-target)))
2031     (unless pos
2032       (error "No section on this line"))
2033     (unless (buffer-live-p (marker-buffer pos))
2034       (error "Buffer for this section was killed"))
2035     pos))
2036
2037 (defun rst-goto-section (&optional kill)
2038   "Go to the section the current line describes."
2039   (interactive)
2040   (let ((pos (rst-toc-mode-find-section)))
2041     (when kill
2042       (kill-buffer (get-buffer rst-toc-buffer-name)))
2043     (pop-to-buffer (marker-buffer pos))
2044     (goto-char pos)
2045     ;; FIXME: make the recentering conditional on scroll.
2046     (recenter 5)))
2047
2048 (defun rst-toc-mode-goto-section ()
2049   "Go to the section the current line describes and kill the toc buffer."
2050   (interactive)
2051   (rst-goto-section t))
2052
2053 (defun rst-toc-mode-mouse-goto (event)
2054   "In `rst-toc' mode, go to the occurrence whose line you click on.
2055 EVENT is the input event."
2056   (interactive "e")
2057   (let (pos)
2058     (with-current-buffer (window-buffer (posn-window (event-end event)))
2059       (save-excursion
2060         (goto-char (posn-point (event-end event)))
2061         (setq pos (rst-toc-mode-find-section))))
2062     (pop-to-buffer (marker-buffer pos))
2063     (goto-char pos)
2064     (recenter 5)))
2065
2066 (defun rst-toc-mode-mouse-goto-kill (event)
2067   "Same as `rst-toc-mode-mouse-goto', but kill TOC buffer as well."
2068   (interactive "e")
2069   (call-interactively 'rst-toc-mode-mouse-goto event)
2070   (kill-buffer (get-buffer rst-toc-buffer-name)))
2071
2072 (defun rst-toc-quit-window ()
2073   "Leave the current TOC buffer."
2074   (interactive)
2075   (quit-window)
2076   (pop-to-buffer rst-toc-return-buffer))
2077
2078 (defvar rst-toc-mode-map
2079   (let ((map (make-sparse-keymap)))
2080     (define-key map [mouse-1] 'rst-toc-mode-mouse-goto-kill)
2081     (define-key map [mouse-2] 'rst-toc-mode-mouse-goto)
2082     (define-key map "\C-m" 'rst-toc-mode-goto-section)
2083     (define-key map "f" 'rst-toc-mode-goto-section)
2084     (define-key map "q" 'rst-toc-quit-window)
2085     (define-key map "z" 'kill-this-buffer)
2086     map)
2087   "Keymap for `rst-toc-mode'.")
2088
2089 (put 'rst-toc-mode 'mode-class 'special)
2090
2091 ;; Could inherit from the new `special-mode'.
2092 (define-derived-mode rst-toc-mode nil "ReST-TOC"
2093   "Major mode for output from \\[rst-toc], the table-of-contents for the document."
2094   (setq buffer-read-only t))
2095
2096 ;; Note: use occur-mode (replace.el) as a good example to complete missing
2097 ;; features.
2098
2099
2100 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2101 ;;
2102 ;; Section movement commands.
2103 ;;
2104
2105 (defun rst-forward-section (&optional offset)
2106   "Skip to the next restructured text section title.
2107 OFFSET specifies how many titles to skip.  Use a negative OFFSET to move
2108 backwards in the file (default is to use 1)."
2109   (interactive)
2110   (let* (;; Default value for offset.
2111          (offset (or offset 1))
2112
2113          ;; Get all the decorations in the file, with their line numbers.
2114          (alldecos (rst-find-all-decorations))
2115
2116          ;; Get the current line.
2117          (curline (line-number-at-pos))
2118
2119          (cur alldecos)
2120          (idx 0)
2121          )
2122
2123     ;; Find the index of the "next" decoration w.r.t. to the current line.
2124     (while (and cur (< (caar cur) curline))
2125       (setq cur (cdr cur))
2126       (incf idx))
2127     ;; 'cur' is the decoration on or following the current line.
2128
2129     (if (and (> offset 0) cur (= (caar cur) curline))
2130         (incf idx))
2131
2132     ;; Find the final index.
2133     (setq idx (+ idx (if (> offset 0) (- offset 1) offset)))
2134     (setq cur (nth idx alldecos))
2135
2136     ;; If the index is positive, goto the line, otherwise go to the buffer
2137     ;; boundaries.
2138     (if (and cur (>= idx 0))
2139         (goto-line (car cur))
2140       (if (> offset 0) (goto-char (point-max)) (goto-char (point-min))))
2141     ))
2142
2143 (defun rst-backward-section ()
2144   "Like `rst-forward-section', except move back one title.
2145 With a prefix argument, move backward by a page."
2146   (interactive)
2147   (rst-forward-section -1))
2148
2149 (defun rst-mark-section (&optional arg allow-extend)
2150   "Select the section that point is currently in."
2151   ;; Cloned from mark-paragraph.
2152   (interactive "p\np")
2153   (unless arg (setq arg 1))
2154   (when (zerop arg)
2155     (error "Cannot mark zero sections"))
2156   (cond ((and allow-extend
2157               (or (and (eq last-command this-command) (mark t))
2158                   (rst-portable-mark-active-p)))
2159          (set-mark
2160           (save-excursion
2161             (goto-char (mark))
2162             (rst-forward-section arg)
2163             (point))))
2164         (t
2165          (rst-forward-section arg)
2166          (push-mark nil t t)
2167          (rst-forward-section (- arg)))))
2168
2169
2170
2171
2172
2173 \f
2174 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2175 ;; Functions to work on item lists (e.g. indent/dedent, enumerate), which are
2176 ;; always 2 or 3 characters apart horizontally with rest.
2177
2178 ;; (FIXME: there is currently a bug that makes the region go away when we do that.)
2179 (defvar rst-shift-fill-region nil
2180   "If non-nil, automatically re-fill the region that is being shifted.")
2181
2182 (defun rst-find-leftmost-column (beg end)
2183   "Find the leftmost column in the region."
2184   (let ((mincol 1000))
2185     (save-excursion
2186       (goto-char beg)
2187       (while (< (point) end)
2188         (back-to-indentation)
2189         (unless (looking-at "[ \t]*$")
2190           (setq mincol (min mincol (current-column))))
2191         (forward-line 1)
2192         ))
2193     mincol))
2194
2195
2196 ;; What we really need to do is compute all the possible alignment possibilities
2197 ;; and then select one.
2198 ;;
2199 ;; .. line-block::
2200 ;;
2201 ;;    a) sdjsds
2202 ;;
2203 ;;       - sdjsd jsjds
2204 ;;
2205 ;;           sdsdsjdsj
2206 ;;
2207 ;;               11. sjdss jddjs
2208 ;;
2209 ;; *  *  * * *   *   *
2210 ;;
2211 ;; Move backwards, accumulate the beginning positions, and also the second
2212 ;; positions, in case the line matches the bullet pattern, and then sort.
2213
2214 (defun rst-compute-bullet-tabs (&optional pt)
2215   "Build the list of possible horizontal alignment points.
2216 Search backwards from point (or point PT if specified) to
2217 build the list of possible horizontal alignment points that
2218 includes the beginning and contents of a restructuredtext
2219 bulleted or enumerated list item.  Return a sorted list
2220 of (COLUMN-NUMBER . LINE) pairs."
2221   (save-excursion
2222     (when pt (goto-char pt))
2223
2224     ;; We work our way backwards and towards the left.
2225     (let ((leftcol 100000) ;; Current column.
2226           (tablist nil) ;; List of tab positions.
2227           )
2228
2229       ;; Start by skipping the current line.
2230       (beginning-of-line 0)
2231
2232       ;; Search backwards for each line.
2233       (while (and (> (point) (point-min))
2234                   (> leftcol 0))
2235
2236         ;; Skip empty lines.
2237         (unless (looking-at "^[ \t]*$")
2238           ;; Inspect the current non-empty line
2239           (back-to-indentation)
2240
2241           ;; Skip lines that are beyond the current column (we want to move
2242           ;; towards the left).
2243           (let ((col (current-column)))
2244             (when (< col leftcol)
2245
2246               ;; Add the beginning of the line as a tabbing point.
2247               (unless (memq col (mapcar 'car tablist))
2248                 (push (cons col (point)) tablist))
2249
2250               ;; Look at the line to figure out if it is a bulleted or enumerate
2251               ;; list item.
2252               (when (looking-at
2253                       (concat
2254                        "\\(?:"
2255                        "\\(\\(?:[0-9a-zA-Z#]\\{1,3\\}[.):-]\\|[*+-]\\)[ \t]+\\)[^ \t\n]"
2256                        "\\|"
2257                        (format "\\(%s%s+[ \t]+\\)[^ \t\n]"
2258                                (regexp-quote (thing-at-point 'char))
2259                                (regexp-quote (thing-at-point 'char)))
2260                        "\\)"
2261                        ))
2262                 ;; Add the column of the contained item.
2263                 (let* ((matchlen (length (or (match-string 1) (match-string 2))))
2264                        (newcol (+ col matchlen)))
2265                   (unless (or (>= newcol leftcol)
2266                               (memq (+ col matchlen) (mapcar 'car tablist)))
2267                     (push (cons (+ col matchlen) (+ (point) matchlen))
2268                           tablist)))
2269                 )
2270
2271               (setq leftcol col)
2272               )))
2273
2274         ;; Move backwards one line.
2275         (beginning-of-line 0))
2276
2277       (sort tablist (lambda (x y) (<= (car x) (car y))))
2278       )))
2279
2280 (defun rst-debug-print-tabs (tablist)
2281   "Insert a line and place special characters at the tab points in TABLIST."
2282   (beginning-of-line)
2283   (insert (concat "\n" (make-string 1000 ? ) "\n"))
2284   (beginning-of-line 0)
2285   (dolist (col tablist)
2286     (beginning-of-line)
2287     (forward-char (car col))
2288     (delete-char 1)
2289     (insert "@")
2290     ))
2291
2292 (defun rst-debug-mark-found (tablist)
2293   "Insert a line and place special characters at the tab points in TABLIST."
2294   (dolist (col tablist)
2295     (when (cdr col)
2296       (goto-char (cdr col))
2297       (insert "@"))))
2298
2299
2300 (defvar rst-shift-basic-offset 2
2301   "Basic horizontal shift distance when there is no preceding alignment tabs.")
2302
2303 (defun rst-shift-region-guts (find-next-fun offset-fun)
2304   "(See `rst-shift-region-right' for a description)."
2305   (let* ((mbeg (set-marker (make-marker) (region-beginning)))
2306          (mend (set-marker (make-marker) (region-end)))
2307          (tabs (rst-compute-bullet-tabs mbeg))
2308          (leftmostcol (rst-find-leftmost-column (region-beginning) (region-end)))
2309          )
2310     ;; Add basic offset tabs at the end of the list.  This is a better
2311     ;; implementation technique than hysteresis and a basic offset because it
2312     ;; insures that movement in both directions is consistently using the same
2313     ;; column positions.  This makes it more predictable.
2314     (setq tabs
2315           (append tabs
2316                   (mapcar (lambda (x) (cons x nil))
2317                           (let ((maxcol 120)
2318                                 (max-lisp-eval-depth 2000))
2319                             (flet ((addnum (x)
2320                                            (if (> x maxcol)
2321                                                nil
2322                                              (cons x (addnum
2323                                                       (+ x rst-shift-basic-offset))))))
2324                               (addnum (or (caar (last tabs)) 0))))
2325                           )))
2326
2327     ;; (For debugging.)
2328     ;;; (save-excursion (goto-char mbeg) (forward-char -1) (rst-debug-print-tabs tabs))))
2329     ;;; (print tabs)
2330     ;;; (save-excursion (rst-debug-mark-found tabs))
2331
2332     ;; Apply the indent.
2333     (indent-rigidly
2334      mbeg mend
2335
2336      ;; Find the next tab after the leftmost columnt.
2337      (let ((tab (funcall find-next-fun tabs leftmostcol)))
2338
2339        (if tab
2340            (progn
2341              (when (cdar tab)
2342                (message "Aligned on '%s'"
2343                         (save-excursion
2344                           (goto-char (cdar tab))
2345                           (buffer-substring-no-properties
2346                            (line-beginning-position)
2347                            (line-end-position))))
2348                )
2349              (- (caar tab) leftmostcol)) ;; Num chars.
2350
2351          ;; Otherwise use the basic offset
2352          (funcall offset-fun rst-shift-basic-offset)
2353          )))
2354
2355     ;; Optionally reindent.
2356     (when rst-shift-fill-region
2357       (fill-region mbeg mend))
2358     ))
2359
2360 (defun rst-shift-region-right (pfxarg)
2361   "Indent region ridigly, by a few characters to the right.
2362 This function first computes all possible alignment columns by
2363 inspecting the lines preceding the region for bulleted or
2364 enumerated list items.  If the leftmost column is beyond the
2365 preceding lines, the region is moved to the right by
2366 `rst-shift-basic-offset'.  With a prefix argument, do not
2367 automatically fill the region."
2368   (interactive "P")
2369   (let ((rst-shift-fill-region
2370          (if (not pfxarg) rst-shift-fill-region)))
2371     (rst-shift-region-guts (lambda (tabs leftmostcol)
2372                              (let ((cur tabs))
2373                                (while (and cur (<= (caar cur) leftmostcol))
2374                                  (setq cur (cdr cur)))
2375                                cur))
2376                            'identity
2377                            )))
2378
2379 (defun rst-shift-region-left (pfxarg)
2380   "Like `rst-shift-region-right', except we move to the left.
2381 Also, if invoked with a negative prefix arg, the entire
2382 indentation is removed, up to the leftmost character in the
2383 region, and automatic filling is disabled."
2384   (interactive "P")
2385   (let ((mbeg (set-marker (make-marker) (region-beginning)))
2386         (mend (set-marker (make-marker) (region-end)))
2387         (leftmostcol (rst-find-leftmost-column
2388                       (region-beginning) (region-end)))
2389         (rst-shift-fill-region
2390          (if (not pfxarg) rst-shift-fill-region)))
2391
2392     (when (> leftmostcol 0)
2393       (if (and pfxarg (< (prefix-numeric-value pfxarg) 0))
2394           (progn
2395             (indent-rigidly (region-beginning) (region-end) (- leftmostcol))
2396             (when rst-shift-fill-region
2397               (fill-region mbeg mend))
2398             )
2399         (rst-shift-region-guts (lambda (tabs leftmostcol)
2400                                  (let ((cur (reverse tabs)))
2401                                    (while (and cur (>= (caar cur) leftmostcol))
2402                                      (setq cur (cdr cur)))
2403                                    cur))
2404                                '-
2405                                ))
2406       )))
2407
2408 (defmacro rst-iterate-leftmost-paragraphs
2409   (beg end first-only body-consequent body-alternative)
2410   "FIXME This definition is old and deprecated / we need to move
2411 to the newer version below:
2412
2413 Call FUN at the beginning of each line, with an argument that
2414 specifies whether we are at the first line of a paragraph that
2415 starts at the leftmost column of the given region BEG and END.
2416 Set FIRST-ONLY to true if you want to callback on the first line
2417 of each paragraph only."
2418   `(save-excursion
2419     (let ((leftcol (rst-find-leftmost-column ,beg ,end))
2420           (endm (set-marker (make-marker) ,end))
2421           )
2422
2423       (do* (;; Iterate lines
2424             (l (progn (goto-char ,beg) (back-to-indentation))
2425                (progn (forward-line 1) (back-to-indentation)))
2426
2427             (previous nil valid)
2428
2429             (curcol (current-column)
2430                     (current-column))
2431
2432             (valid (and (= curcol leftcol)
2433                         (not (looking-at "[ \t]*$")))
2434                    (and (= curcol leftcol)
2435                         (not (looking-at "[ \t]*$"))))
2436             )
2437           ((>= (point) endm))
2438
2439         (if (if ,first-only
2440                 (and valid (not previous))
2441               valid)
2442             ,body-consequent
2443           ,body-alternative)
2444
2445         ))))
2446
2447
2448 (defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body)
2449   "Evaluate BODY for each line in region defined by BEG END.
2450 LEFTMOST is set to true if the line is one of the leftmost of the
2451 entire paragraph.  PARABEGIN is set to true if the line is the
2452 first of a paragraph."
2453   (declare (indent 1) (debug (sexp body)))
2454   (destructuring-bind
2455       (beg end parabegin leftmost isleftmost isempty) spec
2456
2457   `(save-excursion
2458      (let ((,leftmost (rst-find-leftmost-column ,beg ,end))
2459            (endm (set-marker (make-marker) ,end))
2460            )
2461
2462       (do* (;; Iterate lines
2463             (l (progn (goto-char ,beg) (back-to-indentation))
2464                (progn (forward-line 1) (back-to-indentation)))
2465
2466             (empty-line-previous nil ,isempty)
2467
2468             (,isempty (looking-at "[ \t]*$")
2469                         (looking-at "[ \t]*$"))
2470
2471             (,parabegin (not ,isempty)
2472                         (and empty-line-previous
2473                              (not ,isempty)))
2474
2475             (,isleftmost (and (not ,isempty)
2476                               (= (current-column) ,leftmost))
2477                          (and (not ,isempty)
2478                               (= (current-column) ,leftmost)))
2479             )
2480           ((>= (point) endm))
2481
2482         (progn ,@body)
2483
2484         )))))
2485
2486
2487 ;;------------------------------------------------------------------------------
2488
2489 ;; FIXME: these next functions should become part of a larger effort to redo the
2490 ;; bullets in bulletted lists.  The enumerate would just be one of the possible
2491 ;; outputs.
2492 ;;
2493 ;; FIXME: TODO we need to do the enumeration removal as well.
2494
2495 (defun rst-enumerate-region (beg end)
2496   "Add enumeration to all the leftmost paragraphs in the given region.
2497 The region is specified between BEG and END.  With prefix argument,
2498 do all lines instead of just paragraphs."
2499   (interactive "r")
2500   (let ((count 0)
2501         (last-insert-len nil))
2502     (rst-iterate-leftmost-paragraphs
2503      beg end (not current-prefix-arg)
2504      (let ((ins-string (format "%d. " (incf count))))
2505        (setq last-insert-len (length ins-string))
2506        (insert ins-string))
2507      (insert (make-string last-insert-len ?\ ))
2508      )))
2509
2510 (defun rst-bullet-list-region (beg end)
2511   "Add bullets to all the leftmost paragraphs in the given region.
2512 The region is specified between BEG and END.  With prefix argument,
2513 do all lines instead of just paragraphs."
2514   (interactive "r")
2515   (rst-iterate-leftmost-paragraphs
2516    beg end (not current-prefix-arg)
2517    (insert "- ")
2518    (insert "  ")
2519    ))
2520
2521
2522 ;; FIXME: there are some problems left with the following function
2523 ;; implementation:
2524 ;;
2525 ;; * It does not deal with a varying number of digits appropriately
2526 ;; * It does not deal with multiple levels independently, and it should.
2527 ;;
2528 ;; I suppose it does 90% of the job for now.
2529
2530 (defun rst-convert-bullets-to-enumeration (beg end)
2531   "Convert all the bulleted items and enumerated items in the
2532 region to enumerated lists, renumbering as necessary."
2533   (interactive "r")
2534   (let* (;; Find items and convert the positions to markers.
2535          (items (mapcar
2536                  (lambda (x)
2537                    (cons (let ((m (make-marker)))
2538                            (set-marker m (car x))
2539                            m)
2540                          (cdr x)))
2541                  (rst-find-pfx-in-region beg end rst-re-items)))
2542          (count 1)
2543          )
2544     (save-excursion
2545       (dolist (x items)
2546         (goto-char (car x))
2547         (looking-at rst-re-items)
2548         (replace-match (format "%d. " count) nil nil nil 1)
2549         (incf count)
2550         ))
2551     ))
2552
2553
2554
2555 ;;------------------------------------------------------------------------------
2556
2557 (defun rst-line-block-region (rbeg rend &optional pfxarg)
2558   "Toggle line block prefixes for a region.
2559 With prefix argument set the empty lines too."
2560   (interactive "r\nP")
2561   (let ((comment-start "| ")
2562         (comment-end "")
2563         (comment-start-skip "| ")
2564         (comment-style 'indent)
2565         (force (not (not pfxarg))))
2566     (rst-iterate-leftmost-paragraphs-2
2567         (rbeg rend parbegin leftmost isleft isempty)
2568       (when (or force (not isempty))
2569         (move-to-column leftmost force)
2570         (delete-region (point) (+ (point) (- (current-indentation) leftmost)))
2571         (insert "| ")))))
2572
2573
2574 \f
2575 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2576
2577 (require 'font-lock)
2578
2579 (defgroup rst-faces nil "Faces used in Rst Mode"
2580   :group 'rst
2581   :group 'faces
2582   :version "21.1")
2583
2584 (defcustom rst-block-face 'font-lock-keyword-face
2585   "All syntax marking up a special block."
2586   :group 'rst-faces
2587   :type '(face))
2588
2589 (defcustom rst-external-face 'font-lock-type-face
2590   "Field names and interpreted text."
2591   :group 'rst-faces
2592   :type '(face))
2593
2594 (defcustom rst-definition-face 'font-lock-function-name-face
2595   "All other defining constructs."
2596   :group 'rst-faces
2597   :type '(face))
2598
2599 (defcustom rst-directive-face
2600   ;; XEmacs compatibility
2601   (if (boundp 'font-lock-builtin-face)
2602       'font-lock-builtin-face
2603     'font-lock-preprocessor-face)
2604   "Directives and roles."
2605   :group 'rst-faces
2606   :type '(face))
2607
2608 (defcustom rst-comment-face 'font-lock-comment-face
2609   "Comments."
2610   :group 'rst-faces
2611   :type '(face))
2612
2613 (defcustom rst-emphasis1-face
2614   ;; XEmacs compatibility
2615   (if (facep 'italic)
2616       ''italic
2617     'italic)
2618   "Simple emphasis."
2619   :group 'rst-faces
2620   :type '(face))
2621
2622 (defcustom rst-emphasis2-face
2623   ;; XEmacs compatibility
2624   (if (facep 'bold)
2625       ''bold
2626     'bold)
2627   "Double emphasis."
2628   :group 'rst-faces
2629   :type '(face))
2630
2631 (defcustom rst-literal-face 'font-lock-string-face
2632   "Literal text."
2633   :group 'rst-faces
2634   :type '(face))
2635
2636 (defcustom rst-reference-face 'font-lock-variable-name-face
2637   "References to a definition."
2638   :group 'rst-faces
2639   :type '(face))
2640
2641 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2642
2643 (defgroup rst-faces-defaults nil
2644   "Values used to generate default faces for section titles on all levels.
2645 Tweak these if you are content with how section title faces are built in
2646 general but you do not like the details."
2647   :group 'rst-faces
2648   :version "21.1")
2649
2650 (defun rst-set-level-default (sym val)
2651   "Set custom var SYM affecting section title text face and recompute the faces."
2652   (custom-set-default sym val)
2653   ;; Also defines the faces initially when all values are available
2654   (and (boundp 'rst-level-face-max)
2655        (boundp 'rst-level-face-format-light)
2656        (boundp 'rst-level-face-base-color)
2657        (boundp 'rst-level-face-step-light)
2658        (boundp 'rst-level-face-base-light)
2659        (fboundp 'rst-define-level-faces)
2660        (rst-define-level-faces)))
2661
2662 ;; Faces for displaying items on several levels; these definitions define
2663 ;; different shades of grey where the lightest one (i.e. least contrasting) is
2664 ;; used for level 1
2665 (defcustom rst-level-face-max 6
2666   "Maximum depth of levels for which section title faces are defined."
2667   :group 'rst-faces-defaults
2668   :type '(integer)
2669   :set 'rst-set-level-default)
2670 (defcustom rst-level-face-base-color "grey"
2671   "The base name of the color to be used for creating background colors in
2672 ection title faces for all levels."
2673   :group 'rst-faces-defaults
2674   :type '(string)
2675   :set 'rst-set-level-default)
2676 (defcustom rst-level-face-base-light
2677   (if (eq frame-background-mode 'dark)
2678       15
2679     85)
2680   "The lightness factor for the base color.  This value is used for level 1.
2681 The default depends on whether the value of `frame-background-mode' is
2682 `dark' or not."
2683   :group 'rst-faces-defaults
2684   :type '(integer)
2685   :set 'rst-set-level-default)
2686 (defcustom rst-level-face-format-light "%2d"
2687   "The format for the lightness factor appended to the base name of the color.
2688 This value is expanded by `format' with an integer."
2689   :group 'rst-faces-defaults
2690   :type '(string)
2691   :set 'rst-set-level-default)
2692 (defcustom rst-level-face-step-light
2693   (if (eq frame-background-mode 'dark)
2694       7
2695     -7)
2696   "The step width to use for the next color.
2697 The formula
2698
2699     `rst-level-face-base-light'
2700     + (`rst-level-face-max' - 1) * `rst-level-face-step-light'
2701
2702 must result in a color level which appended to `rst-level-face-base-color'
2703 using `rst-level-face-format-light' results in a valid color such as `grey50'.
2704 This color is used as background for section title text on level
2705 `rst-level-face-max'."
2706   :group 'rst-faces-defaults
2707   :type '(integer)
2708   :set 'rst-set-level-default)
2709
2710 (defcustom rst-adornment-faces-alist
2711   (let ((alist '((t . font-lock-keyword-face)
2712                  (nil . font-lock-keyword-face)))
2713         (i 1))
2714     (while (<= i rst-level-face-max)
2715       (nconc alist (list (cons i (intern (format "rst-level-%d-face" i)))))
2716       (setq i (1+ i)))
2717     alist)
2718   "Faces for the various adornment types.
2719 Key is a number (for the section title text of that level),
2720 t (for transitions) or nil (for section title adornment).
2721 If you generally do not like how section title text faces are
2722 set up tweak here.  If the general idea is ok for you but you do not like the
2723 details check the Rst Faces Defaults group."
2724   :group 'rst-faces
2725   :type '(alist
2726           :key-type
2727           (choice
2728            (integer
2729             :tag
2730             "Section level (may not be bigger than `rst-level-face-max')")
2731            (boolean :tag "transitions (on) / section title adornment (off)"))
2732           :value-type (face))
2733   :set-after '(rst-level-face-max))
2734
2735 (defun rst-define-level-faces ()
2736   "Define the faces for the section title text faces from the values."
2737   ;; All variables used here must be checked in `rst-set-level-default'
2738   (let ((i 1))
2739     (while (<= i rst-level-face-max)
2740       (let ((sym (intern (format "rst-level-%d-face" i)))
2741             (doc (format "Face for showing section title text at level %d" i))
2742             (col (format (concat "%s" rst-level-face-format-light)
2743                          rst-level-face-base-color
2744                          (+ (* (1- i) rst-level-face-step-light)
2745                             rst-level-face-base-light))))
2746         (make-empty-face sym)
2747         (set-face-doc-string sym doc)
2748         (set-face-background sym col)
2749         (set sym sym)
2750         (setq i (1+ i))))))
2751
2752
2753 \f
2754 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2755 ;; Font lock
2756
2757 (defvar rst-use-char-classes
2758   (string-match "[[:alpha:]]" "b")
2759   "Non-nil if we can use the character classes in our regexps.")
2760
2761 (defun rst-font-lock-keywords-function ()
2762   "Return keywords to highlight in rst mode according to current settings."
2763   ;; The reST-links in the comments below all relate to sections in
2764   ;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html
2765   (let* ( ;; This gets big - so let's define some abbreviations
2766          ;; horizontal white space
2767          (re-hws "[\t ]")
2768          ;; beginning of line with possible indentation
2769          (re-bol (concat "^" re-hws "*"))
2770          ;; Separates block lead-ins from their content
2771          (re-blksep1 (concat "\\(" re-hws "+\\|$\\)"))
2772          ;; explicit markup tag
2773          (re-emt "\\.\\.")
2774          ;; explicit markup start
2775          (re-ems (concat re-emt re-hws "+"))
2776          ;; inline markup prefix
2777          (re-imp1 (concat "\\(^\\|" re-hws "\\|[-'\"([{</:]\\)"))
2778          ;; inline markup suffix
2779          (re-ims1 (concat "\\(" re-hws "\\|[]-'\")}>/:.,;!?\\]\\|$\\)"))
2780          ;; symbol character
2781          (re-sym1 "\\(\\sw\\|\\s_\\)")
2782          ;; inline markup content begin
2783          (re-imbeg2 "\\(\\S \\|\\S \\([^")
2784
2785          ;; There seems to be a bug leading to error "Stack overflow in regexp
2786          ;; matcher" when "|" or "\\*" are the characters searched for
2787          (re-imendbeg
2788           (if (< emacs-major-version 21)
2789               "]"
2790             "\\]\\|\\\\."))
2791          ;; inline markup content end
2792          (re-imend (concat re-imendbeg "\\)*[^\t \\\\]\\)"))
2793          ;; inline markup content without asterisk
2794          (re-ima2 (concat re-imbeg2 "*" re-imend))
2795          ;; inline markup content without backquote
2796          (re-imb2 (concat re-imbeg2 "`" re-imend))
2797          ;; inline markup content without vertical bar
2798          (re-imv2 (concat re-imbeg2 "|" re-imend))
2799          ;; Supported URI schemes
2800          (re-uris1 "\\(acap\\|cid\\|data\\|dav\\|fax\\|file\\|ftp\\|gopher\\|http\\|https\\|imap\\|ldap\\|mailto\\|mid\\|modem\\|news\\|nfs\\|nntp\\|pop\\|prospero\\|rtsp\\|service\\|sip\\|tel\\|telnet\\|tip\\|urn\\|vemmi\\|wais\\)")
2801          ;; Line starting with adornment and optional whitespace; complete
2802          ;; adornment is in (match-string 1); there must be at least 3
2803          ;; characters because otherwise explicit markup start would be
2804          ;; recognized
2805          (re-ado2 (concat "^\\(\\(["
2806                           (if rst-use-char-classes
2807                               "^[:word:][:space:][:cntrl:]" "^\\w \t\x00-\x1F")
2808                           "]\\)\\2\\2+\\)" re-hws "*$"))
2809          )
2810     (list
2811      ;; FIXME: Block markup is not recognized in blocks after explicit markup
2812      ;; start
2813
2814      ;; Simple `Body Elements`_
2815      ;; `Bullet Lists`_
2816      (list
2817       (concat re-bol "\\([-*+]" re-blksep1 "\\)")
2818       1 rst-block-face)
2819      ;; `Enumerated Lists`_
2820      (list
2821       (concat re-bol "\\((?\\(#\\|[0-9]+\\|[A-Za-z]\\|[IVXLCMivxlcm]+\\)[.)]"
2822               re-blksep1 "\\)")
2823       1 rst-block-face)
2824      ;; `Definition Lists`_ FIXME: missing
2825      ;; `Field Lists`_
2826      (list
2827       (concat re-bol "\\(:[^:\n]+:\\)" re-blksep1)
2828       1 rst-external-face)
2829      ;; `Option Lists`_
2830      (list
2831       (concat re-bol "\\(\\(\\(\\([-+/]\\|--\\)\\sw\\(-\\|\\sw\\)*"
2832               "\\([ =]\\S +\\)?\\)\\(,[\t ]\\)?\\)+\\)\\($\\|[\t ]\\{2\\}\\)")
2833       1 rst-block-face)
2834
2835      ;; `Tables`_ FIXME: missing
2836
2837      ;; All the `Explicit Markup Blocks`_
2838      ;; `Footnotes`_ / `Citations`_
2839      (list
2840       (concat re-bol "\\(" re-ems "\\[[^[\n]+\\]\\)" re-blksep1)
2841       1 rst-definition-face)
2842      ;; `Directives`_ / `Substitution Definitions`_
2843      (list
2844       (concat re-bol "\\(" re-ems "\\)\\(\\(|[^|\n]+|[\t ]+\\)?\\)\\("
2845               re-sym1 "+::\\)" re-blksep1)
2846       (list 1 rst-directive-face)
2847       (list 2 rst-definition-face)
2848       (list 4 rst-directive-face))
2849      ;; `Hyperlink Targets`_
2850      (list
2851       (concat re-bol "\\(" re-ems "_\\([^:\\`\n]\\|\\\\.\\|`[^`\n]+`\\)+:\\)"
2852               re-blksep1)
2853       1 rst-definition-face)
2854      (list
2855       (concat re-bol "\\(__\\)" re-blksep1)
2856       1 rst-definition-face)
2857
2858      ;; All `Inline Markup`_
2859      ;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented
2860      ;; `Strong Emphasis`_
2861      (list
2862       (concat re-imp1 "\\(\\*\\*" re-ima2 "\\*\\*\\)" re-ims1)
2863       2 rst-emphasis2-face)
2864      ;; `Emphasis`_
2865      (list
2866       (concat re-imp1 "\\(\\*" re-ima2 "\\*\\)" re-ims1)
2867       2 rst-emphasis1-face)
2868      ;; `Inline Literals`_
2869      (list
2870       (concat re-imp1 "\\(``" re-imb2 "``\\)" re-ims1)
2871       2 rst-literal-face)
2872      ;; `Inline Internal Targets`_
2873      (list
2874       (concat re-imp1 "\\(_`" re-imb2 "`\\)" re-ims1)
2875       2 rst-definition-face)
2876      ;; `Hyperlink References`_
2877      ;; FIXME: `Embedded URIs`_ not considered
2878      (list
2879       (concat re-imp1 "\\(\\(`" re-imb2 "`\\|\\(\\sw\\(\\sw\\|-\\)+\\sw\\)\\)__?\\)" re-ims1)
2880       2 rst-reference-face)
2881      ;; `Interpreted Text`_
2882      (list
2883       (concat re-imp1 "\\(\\(:" re-sym1 "+:\\)?\\)\\(`" re-imb2 "`\\)\\(\\(:"
2884               re-sym1 "+:\\)?\\)" re-ims1)
2885       (list 2 rst-directive-face)
2886       (list 5 rst-external-face)
2887       (list 8 rst-directive-face))
2888      ;; `Footnote References`_ / `Citation References`_
2889      (list
2890       (concat re-imp1 "\\(\\[[^]]+\\]_\\)" re-ims1)
2891       2 rst-reference-face)
2892      ;; `Substitution References`_
2893      (list
2894       (concat re-imp1 "\\(|" re-imv2 "|\\)" re-ims1)
2895       2 rst-reference-face)
2896      ;; `Standalone Hyperlinks`_
2897      (list
2898       ;; FIXME: This takes it easy by using a whitespace as delimiter
2899       (concat re-imp1 "\\(" re-uris1 ":\\S +\\)" re-ims1)
2900       2 rst-definition-face)
2901      (list
2902       (concat re-imp1 "\\(" re-sym1 "+@" re-sym1 "+\\)" re-ims1)
2903       2 rst-definition-face)
2904
2905      ;; Do all block fontification as late as possible so 'append works
2906
2907      ;; Sections_ / Transitions_
2908      (append
2909       (list
2910        re-ado2)
2911       (if (not rst-mode-lazy)
2912           (list 1 rst-block-face)
2913         (list
2914          (list 'rst-font-lock-handle-adornment
2915                '(progn
2916                   (setq rst-font-lock-adornment-point (match-end 1))
2917                   (point-max))
2918                nil
2919                (list 1 '(cdr (assoc nil rst-adornment-faces-alist))
2920                      'append t)
2921                (list 2 '(cdr (assoc rst-font-lock-level
2922                                     rst-adornment-faces-alist))
2923                      'append t)
2924                (list 3 '(cdr (assoc nil rst-adornment-faces-alist))
2925                      'append t)))))
2926
2927      ;; `Comments`_
2928      (append
2929       (list
2930        (concat re-bol "\\(" re-ems "\\)\[^[|_]\\([^:\n]\\|:\\([^:\n]\\|$\\)\\)*$")
2931
2932        (list 1 rst-comment-face))
2933       (if rst-mode-lazy
2934           (list
2935            (list 'rst-font-lock-find-unindented-line
2936                  '(progn
2937                     (setq rst-font-lock-indentation-point (match-end 1))
2938                     (point-max))
2939                  nil
2940                  (list 0 rst-comment-face 'append)))))
2941      (append
2942       (list
2943        (concat re-bol "\\(" re-emt "\\)\\(\\s *\\)$")
2944        (list 1 rst-comment-face)
2945        (list 2 rst-comment-face))
2946       (if rst-mode-lazy
2947           (list
2948            (list 'rst-font-lock-find-unindented-line
2949                  '(progn
2950                     (setq rst-font-lock-indentation-point 'next)
2951                     (point-max))
2952                  nil
2953                  (list 0 rst-comment-face 'append)))))
2954
2955      ;; `Literal Blocks`_
2956      (append
2957       (list
2958        (concat re-bol "\\(\\([^.\n]\\|\\.[^.\n]\\).*\\)?\\(::\\)$")
2959        (list 3 rst-block-face))
2960       (if rst-mode-lazy
2961           (list
2962            (list 'rst-font-lock-find-unindented-line
2963                  '(progn
2964                     (setq rst-font-lock-indentation-point t)
2965                     (point-max))
2966                  nil
2967                  (list 0 rst-literal-face 'append)))))
2968
2969     ;; `Doctest Blocks`_
2970     (append
2971      (list
2972       (concat re-bol "\\(>>>\\|\\.\\.\\.\\)\\(.+\\)")
2973       (list 1 rst-block-face)
2974       (list 2 rst-literal-face)))
2975     )))
2976
2977
2978
2979 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2980 ;; Indented blocks
2981
2982 (defun rst-forward-indented-block (&optional column limit)
2983   "Move forward across one indented block.
2984 Find the next non-empty line which is not indented at least to COLUMN (defaults
2985 to the column of the point).  Moves point to first character of this line or the
2986 first empty line immediately before it and returns that position.  If there is
2987 no such line before LIMIT (defaults to the end of the buffer) returns nil and
2988 point is not moved."
2989   (interactive)
2990   (let ((clm (or column (current-column)))
2991         (start (point))
2992         fnd beg cand)
2993     (if (not limit)
2994         (setq limit (point-max)))
2995     (save-match-data
2996       (while (and (not fnd) (< (point) limit))
2997         (forward-line 1)
2998         (when (< (point) limit)
2999           (setq beg (point))
3000           (if (looking-at "\\s *$")
3001               (setq cand (or cand beg)) ; An empty line is a candidate
3002             (move-to-column clm)
3003             ;; FIXME: No indentation [(zerop clm)] must be handled in some
3004             ;; useful way - though it is not clear what this should mean at all
3005             (if (string-match
3006                  "^\\s *$" (buffer-substring-no-properties beg (point)))
3007                 (setq cand nil) ; An indented line resets a candidate
3008               (setq fnd (or cand beg)))))))
3009     (goto-char (or fnd start))
3010     fnd))
3011
3012 ;; Stores the point where the current indentation ends if a number. If `next'
3013 ;; indicates `rst-font-lock-find-unindented-line' shall take the indentation
3014 ;; from the next line if this is not empty. If non-nil indicates
3015 ;; `rst-font-lock-find-unindented-line' shall take the indentation from the
3016 ;; next non-empty line. Also used as a trigger for
3017 ;; `rst-font-lock-find-unindented-line'.
3018 (defvar rst-font-lock-indentation-point nil)
3019
3020 (defun rst-font-lock-find-unindented-line (limit)
3021   (let* ((ind-pnt rst-font-lock-indentation-point)
3022          (beg-pnt ind-pnt))
3023     ;; May run only once - enforce this
3024     (setq rst-font-lock-indentation-point nil)
3025     (when (and ind-pnt (not (numberp ind-pnt)))
3026       ;; Find indentation point in next line if any
3027       (setq ind-pnt
3028             (save-excursion
3029               (save-match-data
3030                 (if (eq ind-pnt 'next)
3031                     (when (and (zerop (forward-line 1)) (< (point) limit))
3032                       (setq beg-pnt (point))
3033                       (when (not (looking-at "\\s *$"))
3034                         (looking-at "\\s *")
3035                         (match-end 0)))
3036                   (while (and (zerop (forward-line 1)) (< (point) limit)
3037                               (looking-at "\\s *$")))
3038                   (when (< (point) limit)
3039                     (setq beg-pnt (point))
3040                     (looking-at "\\s *")
3041                     (match-end 0)))))))
3042     (when ind-pnt
3043       (goto-char ind-pnt)
3044       ;; Always succeeds because the limit set by PRE-MATCH-FORM is the
3045       ;; ultimate point to find
3046       (goto-char (or (rst-forward-indented-block nil limit) limit))
3047       (set-match-data (list beg-pnt (point)))
3048       t)))
3049
3050 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3051 ;; Adornments
3052
3053 ;; Stores the point where the current adornment ends. Also used as a trigger
3054 ;; for `rst-font-lock-handle-adornment'.
3055 (defvar rst-font-lock-adornment-point nil)
3056
3057 ;; Here `rst-font-lock-handle-adornment' stores the section level of the
3058 ;; current adornment or t for a transition.
3059 (defvar rst-font-lock-level nil)
3060
3061 ;; FIXME: It would be good if this could be used to markup section titles of
3062 ;; given level with a special key; it would be even better to be able to
3063 ;; customize this so it can be used for a generally available personal style
3064 ;;
3065 ;; FIXME: There should be some way to reset and reload this variable - probably
3066 ;; a special key
3067 ;;
3068 ;; FIXME: Some support for `outline-mode' would be nice which should be based
3069 ;; on this information
3070 (defvar rst-adornment-level-alist nil
3071   "Associates adornments with section levels.
3072 The key is a two character string.  The first character is the adornment
3073 character.  The second character distinguishes underline section titles (`u')
3074 from overline/underline section titles (`o').  The value is the section level.
3075
3076 This is made buffer local on start and adornments found during font lock are
3077 entered.")
3078
3079 ;; Returns section level for adornment key KEY. Adds new section level if KEY
3080 ;; is not found and ADD. If KEY is not a string it is simply returned.
3081 (defun rst-adornment-level (key &optional add)
3082   (let ((fnd (assoc key rst-adornment-level-alist))
3083         (new 1))
3084     (cond
3085      ((not (stringp key))
3086       key)
3087      (fnd
3088       (cdr fnd))
3089      (add
3090       (while (rassoc new rst-adornment-level-alist)
3091         (setq new (1+ new)))
3092       (setq rst-adornment-level-alist
3093             (append rst-adornment-level-alist (list (cons key new))))
3094       new))))
3095
3096 ;; Classifies adornment for section titles and transitions. ADORNMENT is the
3097 ;; complete adornment string as found in the buffer. END is the point after the
3098 ;; last character of ADORNMENT. For overline section adornment LIMIT limits the
3099 ;; search for the matching underline. Returns a list. The first entry is t for
3100 ;; a transition, or a key string for `rst-adornment-level' for a section title.
3101 ;; The following eight values forming four match groups as can be used for
3102 ;; `set-match-data'. First match group contains the maximum points of the whole
3103 ;; construct. Second and last match group matched pure section title adornment
3104 ;; while third match group matched the section title text or the transition.
3105 ;; Each group but the first may or may not exist.
3106 (defun rst-classify-adornment (adornment end limit)
3107   (save-excursion
3108     (save-match-data
3109       (goto-char end)
3110       (let ((ado-ch (aref adornment 0))
3111             (ado-re (regexp-quote adornment))
3112             (end-pnt (point))
3113             (beg-pnt (progn
3114                        (forward-line 0)
3115                        (point)))
3116             (nxt-emp
3117              (save-excursion
3118                (or (not (zerop (forward-line 1)))
3119                    (looking-at "\\s *$"))))
3120             (prv-emp
3121              (save-excursion
3122                (or (not (zerop (forward-line -1)))
3123                    (looking-at "\\s *$"))))
3124             key beg-ovr end-ovr beg-txt end-txt beg-und end-und)
3125         (cond
3126          ((and nxt-emp prv-emp)
3127           ;; A transition
3128           (setq key t)
3129           (setq beg-txt beg-pnt)
3130           (setq end-txt end-pnt))
3131          (prv-emp
3132           ;; An overline
3133           (setq key (concat (list ado-ch) "o"))
3134           (setq beg-ovr beg-pnt)
3135           (setq end-ovr end-pnt)
3136           (forward-line 1)
3137           (setq beg-txt (point))
3138           (while (and (< (point) limit) (not end-txt))
3139             (if (looking-at "\\s *$")
3140                 ;; No underline found
3141                 (setq end-txt (1- (point)))
3142               (when (looking-at (concat "\\(" ado-re "\\)\\s *$"))
3143                 (setq end-und (match-end 1))
3144                 (setq beg-und (point))
3145                 (setq end-txt (1- beg-und))))
3146             (forward-line 1)))
3147          (t
3148           ;; An underline
3149           (setq key (concat (list ado-ch) "u"))
3150           (setq beg-und beg-pnt)
3151           (setq end-und end-pnt)
3152           (setq end-txt (1- beg-und))
3153           (setq beg-txt (progn
3154                           (if (re-search-backward "^\\s *$" 1 'move)
3155                               (forward-line 1))
3156                           (point)))))
3157         (list key
3158               (or beg-ovr beg-txt beg-und)
3159               (or end-und end-txt end-und)
3160               beg-ovr end-ovr beg-txt end-txt beg-und end-und)))))
3161
3162 ;; Handles adornments for font-locking section titles and transitions. Returns
3163 ;; three match groups. First and last match group matched pure overline /
3164 ;; underline adornment while second group matched section title text. Each
3165 ;; group may not exist.
3166 (defun rst-font-lock-handle-adornment (limit)
3167   (let ((ado-pnt rst-font-lock-adornment-point))
3168     ;; May run only once - enforce this
3169     (setq rst-font-lock-adornment-point nil)
3170     (if ado-pnt
3171       (let* ((ado (rst-classify-adornment (match-string-no-properties 1)
3172                                           ado-pnt limit))
3173              (key (car ado))
3174              (mtc (cdr ado)))
3175         (setq rst-font-lock-level (rst-adornment-level key t))
3176         (goto-char (nth 1 mtc))
3177         (set-match-data mtc)
3178         t))))
3179
3180
3181
3182 \f
3183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3184 ;; Support for conversion from within Emacs
3185
3186 (defgroup rst-compile nil
3187   "Settings for support of conversion of reStructuredText
3188 document with \\[rst-compile]."
3189   :group 'rst
3190   :version "21.1")
3191
3192 (defvar rst-compile-toolsets
3193   '((html . ("rst2html.py" ".html" nil))
3194     (latex . ("rst2latex.py" ".tex" nil))
3195     (newlatex . ("rst2newlatex.py" ".tex" nil))
3196     (pseudoxml . ("rst2pseudoxml.py" ".xml" nil))
3197     (xml . ("rst2xml.py" ".xml" nil)))
3198   "Table describing the command to use for each toolset.
3199 An association list of the toolset to a list of the (command to use,
3200 extension of produced filename, options to the tool (nil or a
3201 string)) to be used for converting the document.")
3202
3203 ;; Note for Python programmers not familiar with association lists: you can set
3204 ;; values in an alists like this, e.g. :
3205 ;; (setcdr (assq 'html rst-compile-toolsets)
3206 ;;      '("rst2html.py" ".htm" "--stylesheet=/docutils.css"))
3207
3208
3209 (defvar rst-compile-primary-toolset 'html
3210   "The default toolset for `rst-compile'.")
3211
3212 (defvar rst-compile-secondary-toolset 'latex
3213   "The default toolset for `rst-compile' with a prefix argument.")
3214
3215 (defun rst-compile-find-conf ()
3216   "Look for the configuration file in the parents of the current path."
3217   (interactive)
3218   (let ((file-name "docutils.conf")
3219         (buffer-file (buffer-file-name)))
3220     ;; Move up in the dir hierarchy till we find a change log file.
3221     (let* ((dir (file-name-directory buffer-file))
3222            (prevdir nil))
3223       (while (and (or (not (string= dir prevdir))
3224                       (setq dir nil)
3225                       nil)
3226                   (not (file-exists-p (concat dir file-name))))
3227         ;; Move up to the parent dir and try again.
3228         (setq prevdir dir)
3229         (setq dir (expand-file-name (file-name-directory
3230                                      (directory-file-name
3231                                       (file-name-directory dir)))))
3232         )
3233       (or (and dir (concat dir file-name)) nil)
3234     )))
3235
3236
3237 (require 'compile)
3238
3239 (defun rst-compile (&optional pfxarg)
3240   "Compile command to convert reST document into some output file.
3241 Attempts to find configuration file, if it can, overrides the
3242 options.  There are two commands to choose from, with a prefix
3243 argument, select the alternative toolset."
3244   (interactive "P")
3245   ;; Note: maybe we want to check if there is a Makefile too and not do anything
3246   ;; if that is the case.  I dunno.
3247   (let* ((toolset (cdr (assq (if pfxarg
3248                                  rst-compile-secondary-toolset
3249                                rst-compile-primary-toolset)
3250                         rst-compile-toolsets)))
3251          (command (car toolset))
3252          (extension (cadr toolset))
3253          (options (caddr toolset))
3254          (conffile (rst-compile-find-conf))
3255          (bufname (file-name-nondirectory buffer-file-name))
3256          (outname (file-name-sans-extension bufname)))
3257
3258     ;; Set compile-command before invocation of compile.
3259     (set (make-local-variable 'compile-command)
3260          (mapconcat 'identity
3261                     (list command
3262                           (or options "")
3263                           (if conffile
3264                               (concat "--config=\"" conffile "\"")
3265                             "")
3266                           bufname
3267                           (concat outname extension))
3268                     " "))
3269
3270     ;; Invoke the compile command.
3271     (if (or compilation-read-command current-prefix-arg)
3272         (call-interactively 'compile)
3273       (compile compile-command))
3274     ))
3275
3276 (defun rst-compile-alt-toolset ()
3277   "Compile command with the alternative toolset."
3278   (interactive)
3279   (rst-compile 't))
3280
3281 (defun rst-compile-pseudo-region ()
3282   "Show the pseudo-XML rendering of the current active region,
3283 or of the entire buffer, if the region is not selected."
3284   (interactive)
3285   (with-output-to-temp-buffer "*pseudoxml*"
3286     (shell-command-on-region
3287      (if mark-active (region-beginning) (point-min))
3288      (if mark-active (region-end) (point-max))
3289      "rst2pseudoxml.py"
3290      standard-output)))
3291
3292 (defvar rst-pdf-program "xpdf"
3293   "Program used to preview PDF files.")
3294
3295 (defun rst-compile-pdf-preview ()
3296   "Convert the document to a PDF file and launch a preview program."
3297   (interactive)
3298   (let* ((tmp-filename "/tmp/out.pdf")
3299          (command (format "rst2pdf.py %s %s && %s %s"
3300                           buffer-file-name tmp-filename
3301                           rst-pdf-program tmp-filename)))
3302     (start-process-shell-command "rst-pdf-preview" nil command)
3303     ;; Note: you could also use (compile command) to view the compilation
3304     ;; output.
3305     ))
3306
3307 (defvar rst-slides-program "firefox"
3308   "Program used to preview S5 slides.")
3309
3310 (defun rst-compile-slides-preview ()
3311   "Convert the document to an S5 slide presentation and launch a preview program."
3312   (interactive)
3313   (let* ((tmp-filename "/tmp/slides.html")
3314          (command (format "rst2s5.py %s %s && %s %s"
3315                           buffer-file-name tmp-filename
3316                           rst-slides-program tmp-filename)))
3317     (start-process-shell-command "rst-slides-preview" nil command)
3318     ;; Note: you could also use (compile command) to view the compilation
3319     ;; output.
3320     ))
3321
3322
3323 \f
3324 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3325 ;;
3326 ;; Generic text functions that are more convenient than the defaults.
3327 ;;
3328
3329 (defun rst-replace-lines (fromchar tochar)
3330   "Replace flush-left lines, consisting of multiple FROMCHAR characters,
3331 with equal-length lines of TOCHAR."
3332   (interactive "\
3333 cSearch for flush-left lines of char:
3334 cand replace with char: ")
3335   (save-excursion
3336     (let ((searchre (concat "^" (regexp-quote (string fromchar)) "+\\( *\\)$"))
3337           (found 0))
3338       (while (search-forward-regexp searchre nil t)
3339         (setq found (1+ found))
3340         (goto-char (match-beginning 1))
3341         (let ((width (current-column)))
3342           (rst-delete-entire-line)
3343           (insert-char tochar width)))
3344       (message (format "%d lines replaced." found)))))
3345
3346 (defun rst-join-paragraph ()
3347   "Join lines in current paragraph into one line, removing end-of-lines."
3348   (interactive)
3349   (let ((fill-column 65000)) ; some big number
3350     (call-interactively 'fill-paragraph)))
3351
3352 (defun rst-force-fill-paragraph ()
3353   "Fill paragraph at point, first joining the paragraph's lines into one.
3354 This is useful for filling list item paragraphs."
3355   (interactive)
3356   (rst-join-paragraph)
3357   (fill-paragraph nil))
3358
3359
3360 ;; Generic character repeater function.
3361 ;; For sections, better to use the specialized function above, but this can
3362 ;; be useful for creating separators.
3363 (defun rst-repeat-last-character (&optional tofill)
3364   "Fills the current line up to the length of the preceding line (if not
3365 empty), using the last character on the current line.  If the preceding line is
3366 empty, we use the `fill-column'.
3367
3368 If a prefix argument is provided, use the next line rather than the preceding
3369 line.
3370
3371 If the current line is longer than the desired length, shave the characters off
3372 the current line to fit the desired length.
3373
3374 As an added convenience, if the command is repeated immediately, the alternative
3375 column is used (fill-column vs. end of previous/next line)."
3376   (interactive)
3377   (let* ((curcol (current-column))
3378          (curline (+ (count-lines (point-min) (point))
3379                      (if (eq curcol 0) 1 0)))
3380          (lbp (line-beginning-position 0))
3381          (prevcol (if (and (= curline 1) (not current-prefix-arg))
3382                       fill-column
3383                     (save-excursion
3384                       (forward-line (if current-prefix-arg 1 -1))
3385                       (end-of-line)
3386                       (skip-chars-backward " \t" lbp)
3387                       (let ((cc (current-column)))
3388                         (if (= cc 0) fill-column cc)))))
3389          (rightmost-column
3390           (cond (tofill fill-column)
3391                 ((equal last-command 'rst-repeat-last-character)
3392                  (if (= curcol fill-column) prevcol fill-column))
3393                 (t (save-excursion
3394                      (if (= prevcol 0) fill-column prevcol)))
3395                 )) )
3396     (end-of-line)
3397     (if (> (current-column) rightmost-column)
3398         ;; shave characters off the end
3399         (delete-region (- (point)
3400                           (- (current-column) rightmost-column))
3401                        (point))
3402       ;; fill with last characters
3403       (insert-char (preceding-char)
3404                    (- rightmost-column (current-column))))
3405     ))
3406
3407
3408 (defun rst-portable-mark-active-p ()
3409   "A portable function that returns non-nil if the mark is active."
3410   (cond
3411    ((fboundp 'region-active-p) (region-active-p))
3412    ((boundp 'transient-mark-mode) transient-mark-mode mark-active)))
3413
3414
3415 \f
3416 (provide 'rst)
3417
3418 ;; arch-tag: 255ac0a3-a689-44cb-8643-04ca55ae490d
3419 ;;; rst.el ends here