[Zope-Checkins]
CVS: Zope/lib/python/third_party/docutils/tools/editors/emacs
- README.txt:1.1.4.1 restructuredtext.el:1.1.4.1
rst-html.el:1.1.4.1 rst-mode.el:1.1.4.1
Andreas Jung
andreas at andreas-jung.com
Fri Oct 29 15:08:29 EDT 2004
Update of /cvs-repository/Zope/lib/python/third_party/docutils/tools/editors/emacs
In directory cvs.zope.org:/tmp/cvs-serv23727/lib/python/third_party/docutils/tools/editors/emacs
Added Files:
Tag: Zope-2_7-branch
README.txt restructuredtext.el rst-html.el rst-mode.el
Log Message:
moved docutils to lib/python/third_party
=== Added File Zope/lib/python/third_party/docutils/tools/editors/emacs/README.txt ===
.. -*- coding: iso-8859-1 -*-
=====================================
Emacs Support for reStructuredText_
=====================================
:Date: $Date: 2004/10/29 19:08:28 $
Since reStructuredText punts on the issue of character processing,
here are some useful resources for Emacs users in the Unicode world:
* `xmlunicode.el and unichars.el from Norman Walsh
<http://nwalsh.com/emacs/xmlchars/index.html>`__
* `An essay by Tim Bray, with example code
<http://www.tbray.org/ongoing/When/200x/2003/09/27/UniEmacs>`__
* For Emacs users on Mac OS X, here are some useful useful additions
to your .emacs file.
- To get direct keyboard input of non-ASCII characters (like
"option-e e" resulting in "é" [eacute]), first enable the option
key by setting the command key as your meta key::
(setq mac-command-key-is-meta t) ;; nil for option key
Next, use one of these lines::
(set-keyboard-coding-system 'mac-roman)
(setq mac-keyboard-text-encoding kTextEncodingISOLatin1)
I prefer the first line, because it enables non-Latin-1 characters
as well (em-dash, curly quotes, etc.).
- To enable the display of all characters in the Mac-Roman charset,
first create a fontset listing the fonts to use for each range of
characters using charsets that Emacs understands::
(create-fontset-from-fontset-spec
"-apple-monaco-medium-r-normal--10-*-*-*-*-*-fontset-monaco,
ascii:-apple-monaco-medium-r-normal--10-100-75-75-m-100-mac-roman,
latin-iso8859-1:-apple-monaco-medium-r-normal--10-100-75-75-m-100-mac-roman,
mule-unicode-0100-24ff:-apple-monaco-medium-r-normal--10-100-75-75-m-100-mac-roman")
Latin-1 doesn't cover characters like em-dash and curly quotes, so
"mule-unicode-0100-24ff" is needed.
Next, use that fontset::
(set-frame-font "fontset-monaco")
Other useful resources are in `Andrew Choi's Emacs 21 for Mac OS X
FAQ <http://members.shaw.ca/akochoi-emacs/stories/faq.html>`__.
No matter what platform (or editor) you're using, I recommend the
ProFont__ programmer's font. It's monospaced, small but readable,
similar characters are visually distinctive (like "1lI|", "0O", "ao",
and ".,"), and free.
__ http://www.tobias-jung.de/seekingprofont/
.. _reStructuredText: http://docutils.sf.net/rst.html
=== Added File Zope/lib/python/third_party/docutils/tools/editors/emacs/restructuredtext.el ===
;; Authors: David Goodger <goodger at python.org>;
;; Martin Blais
;; Date: $Date: 2004/10/29 19:08:28 $
;; Copyright: This module has been placed in the public domain.
;;
;; Support code for editing reStructuredText with Emacs indented-text mode.
;; The goal is to create an integrated reStructuredText editing mode.
;;
;; Updates
;; -------
;;
;; 2003-02-25 (blais): updated repeat-last-character function and added
;; a few routines for navigating between titles.
(defun replace-lines (fromchar tochar)
;; by David Goodger
"Replace flush-left lines, consisting of multiple FROMCHAR characters,
with equal-length lines of TOCHAR."
(interactive "\
cSearch for flush-left lines of char:
cand replace with char: ")
(save-excursion
(let* ((fromstr (string fromchar))
(searchre (concat "^" (regexp-quote fromstr) "+ *$"))
(found 0))
(condition-case err
(while t
(search-forward-regexp searchre)
(setq found (1+ found))
(search-backward fromstr) ;; point will be *before* last char
(setq p (1+ (point)))
(beginning-of-line)
(setq l (- p (point)))
(kill-line)
(insert-char tochar l))
(search-failed
(message (format "%d lines replaced." found)))))))
(defun repeat-last-character ()
;; by Martin Blais
"Fills the current line up to the length of the preceding line (if not empty),
using the last character on the current line. If the preceding line is empty,
or if a prefix argument is provided, fill up to the fill-column.
If the current line is longer than the desired length, shave the characters off
the current line to fit the desired length.
As an added convenience, if the command is repeated immediately, the alternative
behaviour is performed."
;; TODO
;; ----
;; It would be useful if only these characters were repeated:
;; =-`:.'"~^_*+#<>!$%&(),/;?@[\]{|}
;; Especially, empty lines shouldn't be repeated.
(interactive)
(let* ((curcol (current-column))
(curline (+ (count-lines (point-min) (point)) (if (eq curcol 0) 1 0)))
(lbp (line-beginning-position 0))
(prevcol (if (= curline 1)
fill-column
(save-excursion
(forward-line -1)
(end-of-line)
(skip-chars-backward " \t" lbp)
(let ((cc (current-column)))
(if (= cc 0) fill-column cc)))))
(rightmost-column
(cond (current-prefix-arg fill-column)
((equal last-command 'repeat-last-character)
(if (= curcol fill-column) prevcol fill-column))
(t (save-excursion
(if (= prevcol 0) fill-column prevcol))) )) )
(end-of-line)
(if (> (current-column) rightmost-column)
;; shave characters off the end
(delete-region (- (point)
(- (current-column) rightmost-column))
(point))
;; fill with last characters
(insert-char (preceding-char)
(- rightmost-column (current-column)))) ))
(defun reST-title-char-p (c)
;; by Martin Blais
"Returns true if the given character is a valid title char."
(and (string-match "[-=`:\\.'\"~^_*+#<>!$%&(),/;?@\\\|]"
(char-to-string c)) t))
(defun reST-forward-title ()
;; by Martin Blais
"Skip to the next restructured text section title."
(interactive)
(let* ( (newpoint
(save-excursion
(forward-char) ;; in case we're right on a title
(while
(not
(and (re-search-forward "^[A-Za-z0-9].*[ \t]*$" nil t)
(reST-title-char-p (char-after (+ (point) 1)))
(looking-at (format "\n%c\\{%d,\\}[ \t]*$"
(char-after (+ (point) 1))
(current-column))))))
(beginning-of-line)
(point))) )
(if newpoint (goto-char newpoint)) ))
(defun reST-backward-title ()
;; by Martin Blais
"Skip to the previous restructured text section title."
(interactive)
(let* ( (newpoint
(save-excursion
;;(forward-char) ;; in case we're right on a title
(while
(not
(and (or (backward-char) t)
(re-search-backward "^[A-Za-z0-9].*[ \t]*$" nil t)
(or (end-of-line) t)
(reST-title-char-p (char-after (+ (point) 1)))
(looking-at (format "\n%c\\{%d,\\}[ \t]*$"
(char-after (+ (point) 1))
(current-column))))))
(beginning-of-line)
(point))) )
(if newpoint (goto-char newpoint)) ))
(defun join-paragraph ()
;; by David Goodger
"Join lines in current paragraph into one line, removing end-of-lines."
(interactive)
(save-excursion
(backward-paragraph 1)
(forward-char 1)
(let ((start (point))) ; remember where we are
(forward-paragraph 1) ; go to the end of the paragraph
(beginning-of-line 0) ; go to the beginning of the previous line
(while (< start (point)) ; as long as we haven't passed where we started
(delete-indentation) ; join this line to the line before
(beginning-of-line))))) ; and go back to the beginning of the line
(defun force-fill-paragraph ()
;; by David Goodger
"Fill paragraph at point, first joining the paragraph's lines into one.
This is useful for filling list item paragraphs."
(interactive)
(join-paragraph)
(fill-paragraph nil))
=== Added File Zope/lib/python/third_party/docutils/tools/editors/emacs/rst-html.el ===
;;; rst-mode.el --- Goodies to automate converting reST documents to HTML.
;; Copyright 2003 Martin Blais <blais at iro.umontreal.ca>
;;
;; 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:
;; This package provides a few functions and variables that can help in
;; automating converting reST documents to HTML from within emacs. You could
;; use a makefile to do this, of use the compile command that this package
;; provides.
;; You can also bind a command to automate converting to HTML:
;; (defun user-rst-mode-hook ()
;; (local-set-key [(control c)(?9)] 'rst-html-compile))
;; (add-hook 'rst-mode-hook 'user-rst-mode-hook)
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Customization:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup rst-html nil
"Settings for conversion to HTML available by \\[rst-html-compile]. Use of
this functionality is discouraged. Get a proper `Makefile' instead."
:group 'rst
:version "21.1")
(defcustom rst-html-command "docutils-html"
"Command to convert an reST file to HTML."
:group 'rst-html
:type '(string))
(defcustom rst-html-stylesheet ""
"Stylesheet for reST to HTML conversion. Empty for no special stylesheet."
:group 'rst-html
:type '(string))
(defcustom rst-html-options ""
"Local file options for reST to HTML conversion.
Stylesheets are set by an own option."
:group 'rst-html
:type '(string))
(defcustom rst-html-extension ".html"
"Extension for HTML output file."
:group 'rst-html
:type '(string))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Conversion to HTML
(defun rst-html-compile ()
"Compile command to convert reST document into HTML."
(interactive)
(let* ((bufname (file-name-nondirectory buffer-file-name))
(outname (file-name-sans-extension bufname))
(ssheet
(or (and (not (zerop (length rst-html-stylesheet)))
(concat "--stylesheet=\"" rst-html-stylesheet "\""))
"")))
(set (make-local-variable 'compile-command)
(mapconcat 'identity
(list rst-html-command
ssheet rst-html-options
bufname (concat outname rst-html-extension))
" "))
(if (or compilation-read-command current-prefix-arg)
(call-interactively 'compile)
(compile compile-command))
))
(defun rst-html-compile-with-conf ()
"Compile command to convert reST document into HTML. Attempts to find
configuration file, if it can, overrides the options."
(interactive)
(let ((conffile (rst-html-find-conf)))
(if conffile
(let* ((bufname (file-name-nondirectory buffer-file-name))
(outname (file-name-sans-extension bufname)))
(set (make-local-variable 'compile-command)
(mapconcat 'identity
(list rst-html-command
(concat "--config=\"" conffile "\"")
bufname (concat outname rst-html-extension))
" "))
(if (or compilation-read-command current-prefix-arg)
(call-interactively 'compile)
(compile compile-command)))
(call-interactively 'rst-html-compile)
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Find the configuration file in the parents.
(defun rst-html-find-conf ()
"Look for the configuration file in the parents of the current path."
(interactive)
(let ((file-name "docutils.conf")
(buffer-file (buffer-file-name)))
;; Move up in the dir hierarchy till we find a change log file.
(let ((dir (file-name-directory buffer-file)))
(while (and (or (not (string= "/" dir)) (setq dir nil) nil)
(not (file-exists-p (concat dir file-name))))
;; Move up to the parent dir and try again.
(setq dir (expand-file-name (file-name-directory
(directory-file-name
(file-name-directory dir))))) )
(or (and dir (concat dir file-name)) nil)
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; rst-mode.el ends here
=== Added File Zope/lib/python/third_party/docutils/tools/editors/emacs/rst-mode.el ===
;;; rst-mode.el --- Mode for viewing and editing reStructuredText-documents.
;; Copyright 2003 Stefan Merten <smerten at 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:
;; This package provides support for documents marked up using the
;; reStructuredText format
;; [http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html].
;; Support includes font locking as well as some convenience functions
;; for editing.
;; The package is based on `text-mode' and inherits some things from it.
;; Particularly `text-mode-hook' is run before `rst-mode-hook'.
;; Add the following lines to your `.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 `.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 `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 `Local Variables in Files' in the Emacs documentation for a
;; more complete discussion.
;;; 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 t
"*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))
;; Faces for displaying items on several levels; these definitions define
;; different shades of grey where the lightest one is used for level 1
(defconst rst-level-face-max 6
"Maximum depth of level faces defined")
(defconst rst-level-face-base-color "grey"
"The base color to be used for creating level faces")
(defconst rst-level-face-base-light 85
"The lightness factor for the base color")
(defconst rst-level-face-format-light "%2d"
"The format for the lightness factor for the base color")
(defconst rst-level-face-step-light -7
"The step width to use for next color")
;; Define the faces
(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)))))
(defcustom rst-adornment-faces-alist
'((1 . rst-level-1-face)
(2 . rst-level-2-face)
(3 . rst-level-3-face)
(4 . rst-level-4-face)
(5 . rst-level-5-face)
(6 . rst-level-6-face)
(t . font-lock-keyword-face)
(nil . font-lock-keyword-face))
"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)."
:group 'rst-faces
:type '(alist :key-type (choice (integer :tag "Section level")
(boolean :tag "transitions (on) / section title adornment (off)"))
:value-type (face)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; rst-mode.el ends here
More information about the Zope-Checkins
mailing list