lisp/textmodes/rst.el

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