lisp/textmodes/rst.el

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