Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
830 lines (754 sloc) 30.7 KB
;;; rst-mode.el --- Mode for viewing and editing reStructuredText-documents.
;; Copyright 2003 Stefan Merten <smerten@oekonux.de>
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;; Commentary:
;; =head1 NAME
;;
;; rst-mode.el --- Mode for viewing and editing reStructuredText-documents.
;; =head1 SYNOPSIS
;;
;; Add the following lines to your F<.emacs> file:
;;
;; (autoload 'rst-mode "rst-mode" "mode for editing reStructuredText documents" t)
;; (setq auto-mode-alist
;; (append '(("\\.rst$" . rst-mode)
;; ("\\.rest$" . rst-mode)) auto-mode-alist))
;;
;; If you are using F<.txt> as a standard extension for reST files as
;; http://docutils.sourceforge.net/FAQ.html#what-s-the-standard-filename-extension-for-a-restructuredtext-file
;; suggests you may use one of the I<Local Variables in Files> mechanism Emacs
;; provides to set the major mode automatically. For instance you may use
;;
;; .. -*- mode: rst -*-
;;
;; in the very first line of your file. However, because this is a major
;; security breach you or your administrator may have chosen to switch that
;; feature off. See I<Local Variables in Files> in the Emacs documentation for
;; a more complete discussion.
;; =head1 DESCRIPTION
;;
;; This package provides support for documents marked up using the
;; reStructuredText format. Support includes font locking as well as some
;; convenience functions for editing. It does this by defining a Emacs major
;; mode.
;;
;; The package is based on C<text-mode> and inherits some things from it.
;; Particularly C<text-mode-hook> is run before C<rst-mode-hook>.
;; =head1 OPTIONS
;;
;; There are a number of things which can be customized using the standard
;; Emacs customization features. There are two customization groups for this
;; mode.
;;
;; =over 4
;;
;; =item rst
;;
;; This group contains some general customizable features.
;;
;; The group is contained in the C<wp> group.
;;
;; =item rst-faces
;;
;; This group contains all necessary for customizing fonts. The default
;; settings use standard C<font-lock-*-face>s so if you set these to your
;; liking they are probably good in C<rst-mode> also.
;;
;; The group is contained in the C<faces> group as well as in the C<rst> group.
;;
;; =item rst-faces-defaults
;;
;; This group contains all necessary for customizing the default fonts used for
;; section title faces.
;;
;; The general idea for section title faces is to have a non-default background
;; but do not change the background. The section level is shown by the
;; lightness of the background color. If you like this general idea of
;; generating faces for section titles but do not like the details this group
;; is the point where you can customize the details. If you do not like the
;; general idea, however, you should customize the faces used in
;; C<rst-adornment-faces-alist>.
;;
;; Note: If you are using a dark background please make sure the variable
;; C<frame-background-mode> is set to the symbol C<dark>. This triggers
;; some default values which are probably right for you.
;;
;; The group is contained in the C<rst-faces> group.
;;
;; =back
;;
;; All customizable features have a comment explaining their meaning. Refer to
;; the customization of your Emacs (try C<M-x customize>).
;; =head1 SEE ALSO
;;
;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html
;; =head1 AUTHOR
;;
;; Stefan Merten <smerten AT oekonux.de>
;; =head1 LICENSE
;;
;; This program is licensed under the terms of the GPL. See
;;
;; http://www.gnu.org/licenses/gpl.txt
;; =head1 AVAILABILITY
;;
;; See
;;
;; http://www.merten-home.de/FreeSoftware/rst-mode/
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Customization:
(defgroup rst nil "Support for reStructuredText documents"
:group 'wp
:version "21.1"
:link '(url-link "http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html"))
(defcustom rst-mode-hook nil
"Hook run when Rst Mode is turned on. The hook for Text Mode is run before
this one."
:group 'rst
:type '(hook))
(defcustom rst-mode-lazy nil
"*If non-nil Rst Mode font-locks comment, literal blocks, and section titles
correctly. Because this is really slow it switches on Lazy Lock Mode
automatically. You may increase Lazy Lock Defer Time for reasonable results.
If nil comments and literal blocks are font-locked only on the line they start.
The value of this variable is used when Rst Mode is turned on."
:group 'rst
:type '(boolean))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup rst-faces nil "Faces used in Rst Mode"
:group 'rst
:group 'faces
:version "21.1")
(defcustom rst-block-face 'font-lock-keyword-face
"All syntax marking up a special block"
:group 'rst-faces
:type '(face))
(defcustom rst-external-face 'font-lock-type-face
"Field names and interpreted text"
:group 'rst-faces
:type '(face))
(defcustom rst-definition-face 'font-lock-function-name-face
"All other defining constructs"
:group 'rst-faces
:type '(face))
(defcustom rst-directive-face
;; XEmacs compatibility
(if (boundp 'font-lock-builtin-face)
'font-lock-builtin-face
'font-lock-preprocessor-face)
"Directives and roles"
:group 'rst-faces
:type '(face))
(defcustom rst-comment-face 'font-lock-comment-face
"Comments"
:group 'rst-faces
:type '(face))
(defcustom rst-emphasis1-face
;; XEmacs compatibility
(if (facep 'italic)
''italic
'italic)
"Simple emphasis"
:group 'rst-faces
:type '(face))
(defcustom rst-emphasis2-face
;; XEmacs compatibility
(if (facep 'bold)
''bold
'bold)
"Double emphasis"
:group 'rst-faces
:type '(face))
(defcustom rst-literal-face 'font-lock-string-face
"Literal text"
:group 'rst-faces
:type '(face))
(defcustom rst-reference-face 'font-lock-variable-name-face
"References to a definition"
:group 'rst-faces
:type '(face))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup rst-faces-defaults nil
"Values used to generate default faces for section titles on all levels.
Tweak these if you are content with how section title faces are built in
general but you do not like the details."
:group 'rst-faces
:version "21.1")
(defun rst-define-level-faces ()
"Define the faces for the section title text faces from the values."
;; All variables used here must be checked in `rst-set-level-default'
(let ((i 1))
(while (<= i rst-level-face-max)
(let ((sym (intern (format "rst-level-%d-face" i)))
(doc (format "Face for showing section title text at level %d" i))
(col (format (concat "%s" rst-level-face-format-light)
rst-level-face-base-color
(+ (* (1- i) rst-level-face-step-light)
rst-level-face-base-light))))
(make-empty-face sym)
(set-face-doc-string sym doc)
(set-face-background sym col)
(set sym sym)
(setq i (1+ i))))))
(defun rst-set-level-default (sym val)
"Set a customized value affecting section title text face and recompute the
faces."
(custom-set-default sym val)
;; Also defines the faces initially when all values are available
(and (boundp 'rst-level-face-max)
(boundp 'rst-level-face-format-light)
(boundp 'rst-level-face-base-color)
(boundp 'rst-level-face-step-light)
(boundp 'rst-level-face-base-light)
(rst-define-level-faces)))
;; Faces for displaying items on several levels; these definitions define
;; different shades of grey where the lightest one (i.e. least contrasting) is
;; used for level 1
(defcustom rst-level-face-max 6
"Maximum depth of levels for which section title faces are defined."
:group 'rst-faces-defaults
:type '(integer)
:set 'rst-set-level-default)
(defcustom rst-level-face-base-color "grey"
"The base name of the color to be used for creating background colors in
ection title faces for all levels."
:group 'rst-faces-defaults
:type '(string)
:set 'rst-set-level-default)
(defcustom rst-level-face-base-light
(if (eq frame-background-mode 'dark)
15
85)
"The lightness factor for the base color. This value is used for level 1. The
default depends on whether the value of `frame-background-mode' is `dark' or
not."
:group 'rst-faces-defaults
:type '(integer)
:set 'rst-set-level-default)
(defcustom rst-level-face-format-light "%2d"
"The format for the lightness factor appended to the base name of the color.
This value is expanded by `format' with an integer."
:group 'rst-faces-defaults
:type '(string)
:set 'rst-set-level-default)
(defcustom rst-level-face-step-light
(if (eq frame-background-mode 'dark)
7
-7)
"The step width to use for the next color. The formula
`rst-level-face-base-light' + (`rst-level-face-max' - 1) * `rst-level-face-step-light'
must result in a color level which appended to `rst-level-face-base-color'
using `rst-level-face-format-light' results in a valid color such as `grey50'.
This color is used as background for section title text on level
`rst-level-face-max'."
:group 'rst-faces-defaults
:type '(integer)
:set 'rst-set-level-default)
(defcustom rst-adornment-faces-alist
(let ((alist '((t . font-lock-keyword-face)
(nil . font-lock-keyword-face)))
(i 1))
(while (<= i rst-level-face-max)
(nconc alist (list (cons i (intern (format "rst-level-%d-face" i)))))
(setq i (1+ i)))
alist)
"Provides faces for the various adornment types. Key is a number (for the
section title text of that level), t (for transitions) or nil (for section
title adornment). If you generally do not like how section title text faces are
set up tweak here. If the general idea is ok for you but you do not like the
details check the Rst Faces Defaults group."
:group 'rst-faces
:type '(alist :key-type (choice (integer :tag "Section level (may not be bigger than `rst-level-face-max')")
(boolean :tag "transitions (on) / section title adornment (off)"))
:value-type (face))
:set-after '(rst-level-face-max))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FIXME: Code from `restructuredtext.el' should be integrated
(defvar rst-mode-syntax-table nil
"Syntax table used while in rst mode.")
(unless rst-mode-syntax-table
(setq rst-mode-syntax-table (make-syntax-table text-mode-syntax-table))
(modify-syntax-entry ?$ "." rst-mode-syntax-table)
(modify-syntax-entry ?% "." rst-mode-syntax-table)
(modify-syntax-entry ?& "." rst-mode-syntax-table)
(modify-syntax-entry ?' "." rst-mode-syntax-table)
(modify-syntax-entry ?* "." rst-mode-syntax-table)
(modify-syntax-entry ?+ "." rst-mode-syntax-table)
(modify-syntax-entry ?. "_" rst-mode-syntax-table)
(modify-syntax-entry ?/ "." rst-mode-syntax-table)
(modify-syntax-entry ?< "." rst-mode-syntax-table)
(modify-syntax-entry ?= "." rst-mode-syntax-table)
(modify-syntax-entry ?> "." rst-mode-syntax-table)
(modify-syntax-entry ?\\ "\\" rst-mode-syntax-table)
(modify-syntax-entry ?| "." rst-mode-syntax-table)
(modify-syntax-entry ?_ "." rst-mode-syntax-table)
)
(defvar rst-mode-abbrev-table nil
"Abbrev table used while in rst mode.")
(define-abbrev-table 'rst-mode-abbrev-table ())
;; FIXME: Movement keys to skip forward / backward over or mark an indented
;; block could be defined; keys to markup section titles based on
;; `rst-adornment-level-alist' would be useful
(defvar rst-mode-map nil
"Keymap for rst mode. This inherits from Text mode.")
(unless rst-mode-map
(setq rst-mode-map (copy-keymap text-mode-map)))
(defun rst-mode ()
"Major mode for editing reStructuredText documents.
You may customize `rst-mode-lazy' to switch font-locking of blocks.
\\{rst-mode-map}
Turning on `rst-mode' calls the normal hooks `text-mode-hook' and
`rst-mode-hook'."
(interactive)
(kill-all-local-variables)
;; Maps and tables
(use-local-map rst-mode-map)
(setq local-abbrev-table rst-mode-abbrev-table)
(set-syntax-table rst-mode-syntax-table)
;; For editing text
;;
;; FIXME: It would be better if this matches more exactly the start of a reST
;; paragraph; however, this not always possible with a simple regex because
;; paragraphs are determined by indentation of the following line
(set (make-local-variable 'paragraph-start)
(concat page-delimiter "\\|[ \t]*$"))
(if (eq ?^ (aref paragraph-start 0))
(setq paragraph-start (substring paragraph-start 1)))
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'indent-line-function) 'indent-relative-maybe)
(set (make-local-variable 'adaptive-fill-mode) t)
(set (make-local-variable 'comment-start) ".. ")
;; Special variables
(make-local-variable 'rst-adornment-level-alist)
;; Font lock
(set (make-local-variable 'font-lock-defaults)
'(rst-font-lock-keywords-function
t nil nil nil
(font-lock-multiline . t)
(font-lock-mark-block-function . mark-paragraph)))
(when (boundp 'font-lock-support-mode)
;; rst-mode has its own mind about font-lock-support-mode
(make-local-variable 'font-lock-support-mode)
(cond
((and (not rst-mode-lazy) (not font-lock-support-mode)))
;; No support mode set and none required - leave it alone
((or (not font-lock-support-mode) ;; No support mode set (but required)
(symbolp font-lock-support-mode)) ;; or a fixed mode for all
(setq font-lock-support-mode
(list (cons 'rst-mode (and rst-mode-lazy 'lazy-lock-mode))
(cons t font-lock-support-mode))))
((and (listp font-lock-support-mode)
(not (assoc 'rst-mode font-lock-support-mode)))
;; A list of modes missing rst-mode
(setq font-lock-support-mode
(append '((cons 'rst-mode (and rst-mode-lazy 'lazy-lock-mode)))
font-lock-support-mode)))))
;; Names and hooks
(setq mode-name "reST")
(setq major-mode 'rst-mode)
(run-hooks 'text-mode-hook)
(run-hooks 'rst-mode-hook))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Font lock
(defun rst-font-lock-keywords-function ()
"Returns keywords to highlight in rst mode according to current settings."
;; The reST-links in the comments below all relate to sections in
;; http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html
(let* ( ;; This gets big - so let's define some abbreviations
;; horizontal white space
(re-hws "[\t ]")
;; beginning of line with possible indentation
(re-bol (concat "^" re-hws "*"))
;; Separates block lead-ins from their content
(re-blksep1 (concat "\\(" re-hws "+\\|$\\)"))
;; explicit markup tag
(re-emt "\\.\\.")
;; explicit markup start
(re-ems (concat re-emt re-hws "+"))
;; inline markup prefix
(re-imp1 (concat "\\(^\\|" re-hws "\\|[-'\"([{</:]\\)"))
;; inline markup suffix
(re-ims1 (concat "\\(" re-hws "\\|[]-'\")}>/:.,;!?\\]\\|$\\)"))
;; symbol character
(re-sym1 "\\(\\sw\\|\\s_\\)")
;; inline markup content begin
(re-imbeg2 "\\(\\S \\|\\S \\([^")
;; There seems to be a bug leading to error "Stack overflow in regexp
;; matcher" when "|" or "\\*" are the characters searched for
(re-imendbeg
(if (< emacs-major-version 21)
"]"
"\\]\\|\\\\."))
;; inline markup content end
(re-imend (concat re-imendbeg "\\)*[^\t \\\\]\\)"))
;; inline markup content without asterisk
(re-ima2 (concat re-imbeg2 "*" re-imend))
;; inline markup content without backquote
(re-imb2 (concat re-imbeg2 "`" re-imend))
;; inline markup content without vertical bar
(re-imv2 (concat re-imbeg2 "|" re-imend))
;; Supported URI schemes
(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\\)")
;; Line starting with adornment and optional whitespace; complete
;; adornment is in (match-string 1); there must be at least 3
;; characters because otherwise explicit markup start would be
;; recognized
(re-ado2 (concat "^\\(\\(["
(if (or
(< emacs-major-version 21)
(save-match-data
(string-match "XEmacs\\|Lucid" emacs-version)))
"^a-zA-Z0-9 \t\x00-\x1F"
"^[:word:][:space:][:cntrl:]")
"]\\)\\2\\2+\\)" re-hws "*$"))
)
(list
;; FIXME: Block markup is not recognized in blocks after explicit markup
;; start
;; Simple `Body Elements`_
;; `Bullet Lists`_
(list
(concat re-bol "\\([-*+]" re-blksep1 "\\)")
1 rst-block-face)
;; `Enumerated Lists`_
(list
(concat re-bol "\\((?\\([0-9]+\\|[A-Za-z]\\|[IVXLCMivxlcm]+\\)[.)]" re-blksep1 "\\)")
1 rst-block-face)
;; `Definition Lists`_ FIXME: missing
;; `Field Lists`_
(list
(concat re-bol "\\(:[^:]+:\\)" re-blksep1)
1 rst-external-face)
;; `Option Lists`_
(list
(concat re-bol "\\(\\(\\(\\([-+/]\\|--\\)\\sw\\(-\\|\\sw\\)*\\([ =]\\S +\\)?\\)\\(,[\t ]\\)?\\)+\\)\\($\\|[\t ]\\{2\\}\\)")
1 rst-block-face)
;; `Tables`_ FIXME: missing
;; All the `Explicit Markup Blocks`_
;; `Footnotes`_ / `Citations`_
(list
(concat re-bol "\\(" re-ems "\\[[^[]+\\]\\)" re-blksep1)
1 rst-definition-face)
;; `Directives`_ / `Substitution Definitions`_
(list
(concat re-bol "\\(" re-ems "\\)\\(\\(|[^|]+|[\t ]+\\)?\\)\\(" re-sym1 "+::\\)" re-blksep1)
(list 1 rst-directive-face)
(list 2 rst-definition-face)
(list 4 rst-directive-face))
;; `Hyperlink Targets`_
(list
(concat re-bol "\\(" re-ems "_\\([^:\\`]\\|\\\\.\\|`[^`]+`\\)+:\\)" re-blksep1)
1 rst-definition-face)
(list
(concat re-bol "\\(__\\)" re-blksep1)
1 rst-definition-face)
;; All `Inline Markup`_
;; FIXME: Condition 5 preventing fontification of e.g. "*" not implemented
;; `Strong Emphasis`_
(list
(concat re-imp1 "\\(\\*\\*" re-ima2 "\\*\\*\\)" re-ims1)
2 rst-emphasis2-face)
;; `Emphasis`_
(list
(concat re-imp1 "\\(\\*" re-ima2 "\\*\\)" re-ims1)
2 rst-emphasis1-face)
;; `Inline Literals`_
(list
(concat re-imp1 "\\(``" re-imb2 "``\\)" re-ims1)
2 rst-literal-face)
;; `Inline Internal Targets`_
(list
(concat re-imp1 "\\(_`" re-imb2 "`\\)" re-ims1)
2 rst-definition-face)
;; `Hyperlink References`_
;; FIXME: `Embedded URIs`_ not considered
(list
(concat re-imp1 "\\(\\(`" re-imb2 "`\\|\\sw+\\)__?\\)" re-ims1)
2 rst-reference-face)
;; `Interpreted Text`_
(list
(concat re-imp1 "\\(\\(:" re-sym1 "+:\\)?\\)\\(`" re-imb2 "`\\)\\(\\(:" re-sym1 "+:\\)?\\)" re-ims1)
(list 2 rst-directive-face)
(list 5 rst-external-face)
(list 8 rst-directive-face))
;; `Footnote References`_ / `Citation References`_
(list
(concat re-imp1 "\\(\\[[^]]+\\]_\\)" re-ims1)
2 rst-reference-face)
;; `Substitution References`_
(list
(concat re-imp1 "\\(|" re-imv2 "|\\)" re-ims1)
2 rst-reference-face)
;; `Standalone Hyperlinks`_
(list
;; FIXME: This takes it easy by using a whitespace as delimiter
(concat re-imp1 "\\(" re-uris1 ":\\S +\\)" re-ims1)
2 rst-definition-face)
(list
(concat re-imp1 "\\(" re-sym1 "+@" re-sym1 "+\\)" re-ims1)
2 rst-definition-face)
;; Do all block fontification as late as possible so 'append works
;; Sections_ / Transitions_
(append
(list
re-ado2)
(if (not rst-mode-lazy)
(list 1 rst-block-face)
(list
(list 'rst-font-lock-handle-adornment
'(progn
(setq rst-font-lock-adornment-point (match-end 1))
(point-max))
nil
(list 1 '(cdr (assoc nil rst-adornment-faces-alist))
'append t)
(list 2 '(cdr (assoc rst-font-lock-level rst-adornment-faces-alist))
'append t)
(list 3 '(cdr (assoc nil rst-adornment-faces-alist))
'append t)))))
;; `Comments`_
(append
(list
(concat re-bol "\\(" re-ems "\\)\[^[|_]\\([^:]\\|:\\([^:]\\|$\\)\\)*$")
(list 1 rst-comment-face))
(if rst-mode-lazy
(list
(list 'rst-font-lock-find-unindented-line
'(progn
(setq rst-font-lock-indentation-point (match-end 1))
(point-max))
nil
(list 0 rst-comment-face 'append)))))
(append
(list
(concat re-bol "\\(" re-emt "\\)\\(\\s *\\)$")
(list 1 rst-comment-face)
(list 2 rst-comment-face))
(if rst-mode-lazy
(list
(list 'rst-font-lock-find-unindented-line
'(progn
(setq rst-font-lock-indentation-point 'next)
(point-max))
nil
(list 0 rst-comment-face 'append)))))
;; `Literal Blocks`_
(append
(list
(concat re-bol "\\(\\([^.\n]\\|\\.[^.\n]\\).*\\)?\\(::\\)$")
(list 3 rst-block-face))
(if rst-mode-lazy
(list
(list 'rst-font-lock-find-unindented-line
'(progn
(setq rst-font-lock-indentation-point t)
(point-max))
nil
(list 0 rst-literal-face 'append)))))
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Indented blocks
(defun rst-forward-indented-block (&optional column limit)
"Move forward across one indented block.
Find the next non-empty line which is not indented at least to COLUMN (defaults
to the column of the point). Moves point to first character of this line or the
first empty line immediately before it and returns that position. If there is
no such line before LIMIT (defaults to the end of the buffer) returns nil and
point is not moved."
(interactive)
(let ((clm (or column (current-column)))
(start (point))
fnd beg cand)
(if (not limit)
(setq limit (point-max)))
(save-match-data
(while (and (not fnd) (< (point) limit))
(forward-line 1)
(when (< (point) limit)
(setq beg (point))
(if (looking-at "\\s *$")
(setq cand (or cand beg)) ; An empty line is a candidate
(move-to-column clm)
;; FIXME: No indentation [(zerop clm)] must be handled in some
;; useful way - though it is not clear what this should mean at all
(if (string-match
"^\\s *$" (buffer-substring-no-properties beg (point)))
(setq cand nil) ; An indented line resets a candidate
(setq fnd (or cand beg)))))))
(goto-char (or fnd start))
fnd))
;; Stores the point where the current indentation ends if a number. If `next'
;; indicates `rst-font-lock-find-unindented-line' shall take the indentation
;; from the next line if this is not empty. If non-nil indicates
;; `rst-font-lock-find-unindented-line' shall take the indentation from the
;; next non-empty line. Also used as a trigger for
;; `rst-font-lock-find-unindented-line'.
(defvar rst-font-lock-indentation-point nil)
(defun rst-font-lock-find-unindented-line (limit)
(let* ((ind-pnt rst-font-lock-indentation-point)
(beg-pnt ind-pnt))
;; May run only once - enforce this
(setq rst-font-lock-indentation-point nil)
(when (and ind-pnt (not (numberp ind-pnt)))
;; Find indentation point in next line if any
(setq ind-pnt
(save-excursion
(save-match-data
(if (eq ind-pnt 'next)
(when (and (zerop (forward-line 1)) (< (point) limit))
(setq beg-pnt (point))
(when (not (looking-at "\\s *$"))
(looking-at "\\s *")
(match-end 0)))
(while (and (zerop (forward-line 1)) (< (point) limit)
(looking-at "\\s *$")))
(when (< (point) limit)
(setq beg-pnt (point))
(looking-at "\\s *")
(match-end 0)))))))
(when ind-pnt
(goto-char ind-pnt)
;; Always succeeds because the limit set by PRE-MATCH-FORM is the
;; ultimate point to find
(goto-char (or (rst-forward-indented-block nil limit) limit))
(set-match-data (list beg-pnt (point)))
t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Adornments
;; Stores the point where the current adornment ends. Also used as a trigger
;; for `rst-font-lock-handle-adornment'.
(defvar rst-font-lock-adornment-point nil)
;; Here `rst-font-lock-handle-adornment' stores the section level of the
;; current adornment or t for a transition.
(defvar rst-font-lock-level nil)
;; FIXME: It would be good if this could be used to markup section titles of
;; given level with a special key; it would be even better to be able to
;; customize this so it can be used for a generally available personal style
;;
;; FIXME: There should be some way to reset and reload this variable - probably
;; a special key
;;
;; FIXME: Some support for `outline-mode' would be nice which should be based
;; on this information
(defvar rst-adornment-level-alist nil
"Associates adornments with section levels.
The key is a two character string. The first character is the adornment
character. The second character distinguishes underline section titles (`u')
from overline/underline section titles (`o'). The value is the section level.
This is made buffer local on start and adornments found during font lock are
entered.")
;; Returns section level for adornment key KEY. Adds new section level if KEY
;; is not found and ADD. If KEY is not a string it is simply returned.
(defun rst-adornment-level (key &optional add)
(let ((fnd (assoc key rst-adornment-level-alist))
(new 1))
(cond
((not (stringp key))
key)
(fnd
(cdr fnd))
(add
(while (rassoc new rst-adornment-level-alist)
(setq new (1+ new)))
(setq rst-adornment-level-alist
(append rst-adornment-level-alist (list (cons key new))))
new))))
;; Classifies adornment for section titles and transitions. ADORNMENT is the
;; complete adornment string as found in the buffer. END is the point after the
;; last character of ADORNMENT. For overline section adornment LIMIT limits the
;; search for the matching underline. Returns a list. The first entry is t for
;; a transition, or a key string for `rst-adornment-level' for a section title.
;; The following eight values forming four match groups as can be used for
;; `set-match-data'. First match group contains the maximum points of the whole
;; construct. Second and last match group matched pure section title adornment
;; while third match group matched the section title text or the transition.
;; Each group but the first may or may not exist.
(defun rst-classify-adornment (adornment end limit)
(save-excursion
(save-match-data
(goto-char end)
(let ((ado-ch (aref adornment 0))
(ado-re (regexp-quote adornment))
(end-pnt (point))
(beg-pnt (progn
(forward-line 0)
(point)))
(nxt-emp
(save-excursion
(or (not (zerop (forward-line 1)))
(looking-at "\\s *$"))))
(prv-emp
(save-excursion
(or (not (zerop (forward-line -1)))
(looking-at "\\s *$"))))
key beg-ovr end-ovr beg-txt end-txt beg-und end-und)
(cond
((and nxt-emp prv-emp)
;; A transition
(setq key t)
(setq beg-txt beg-pnt)
(setq end-txt end-pnt))
(prv-emp
;; An overline
(setq key (concat (list ado-ch) "o"))
(setq beg-ovr beg-pnt)
(setq end-ovr end-pnt)
(forward-line 1)
(setq beg-txt (point))
(while (and (< (point) limit) (not end-txt))
(if (looking-at "\\s *$")
;; No underline found
(setq end-txt (1- (point)))
(when (looking-at (concat "\\(" ado-re "\\)\\s *$"))
(setq end-und (match-end 1))
(setq beg-und (point))
(setq end-txt (1- beg-und))))
(forward-line 1)))
(t
;; An underline
(setq key (concat (list ado-ch) "u"))
(setq beg-und beg-pnt)
(setq end-und end-pnt)
(setq end-txt (1- beg-und))
(setq beg-txt (progn
(if (re-search-backward "^\\s *$" 1 'move)
(forward-line 1))
(point)))))
(list key
(or beg-ovr beg-txt beg-und)
(or end-und end-txt end-und)
beg-ovr end-ovr beg-txt end-txt beg-und end-und)))))
;; Handles adornments for font-locking section titles and transitions. Returns
;; three match groups. First and last match group matched pure overline /
;; underline adornment while second group matched section title text. Each
;; group may not exist.
(defun rst-font-lock-handle-adornment (limit)
(let ((ado-pnt rst-font-lock-adornment-point))
;; May run only once - enforce this
(setq rst-font-lock-adornment-point nil)
(if ado-pnt
(let* ((ado (rst-classify-adornment (match-string-no-properties 1)
ado-pnt limit))
(key (car ado))
(mtc (cdr ado)))
(setq rst-font-lock-level (rst-adornment-level key t))
(goto-char (nth 1 mtc))
(set-match-data mtc)
t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'rst-mode)
;;; rst-mode.el ends here
Something went wrong with that request. Please try again.