Menu
▾
▴
[Docutils-checkins] docutils/tools/editors/emacs rst-mode.el,1.2,1.3
|
From: Stefan M. <sm...@us...> - 2003-04-10 20:05:24
|
Update of /cvsroot/docutils/docutils/tools/editors/emacs In directory sc8-pr-cvs1:/tmp/cvs-serv11218/tools/editors/emacs Modified Files: rst-mode.el Log Message: Added standard Emacs customization and a more modern use of `font-lock-defaults'. Rearranged code so it is clearer and can be reused more easily. Index: rst-mode.el =================================================================== RCS file: /cvsroot/docutils/docutils/tools/editors/emacs/rst-mode.el,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- rst-mode.el 3 Apr 2003 22:46:21 -0000 1.2 +++ rst-mode.el 10 Apr 2003 20:05:20 -0000 1.3 @@ -1,3 +1,5 @@ +;;; rst-mode.el --- Mode for viewing and editing reStructuredText-documents. + ;; Copyright 2003 Stefan Merten ;; ;; This program is free software; you can redistribute it and/or modify @@ -14,8 +16,16 @@ ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;;; rst-mode.el --- Mode for viewing and editing reStructuredText-documents. -;; +;;; Commentary: + +;; This package provides support for documents marked up using the +;; reStructuredText format +;; [http://docutils.sourceforge.net/spec/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) @@ -26,18 +36,82 @@ ;;; Code: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Customization +;;; Customization: -(defvar rst-mode-lazy t - "If non-nil `rst-mode' font-locks comment, literal blocks, and sections -correctly. Because this is really slow it switches on `lazy-lock-mode' -automatically. You may increase `lazy-lock-defer-time' for reasonable results. +(defgroup rst nil "Support for reStructuredText documents" + :group 'wp + :version "21.1" + :link '(url-link "http://docutils.sourceforge.net/spec/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 loaded.") +The value of this variable is used when Rst Mode is turned on." + :group 'rst + :type '(boolean)) -;; Faces for displaying items on several levels +(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 'font-lock-builtin-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 'italic + "Simple emphasis" + :group 'rst-faces + :type '(face)) + +(defcustom rst-emphasis2-face '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" @@ -53,7 +127,7 @@ (let ((i 1)) (while (<= i rst-level-face-max) (let ((sym (intern (format "rst-level-%d-face" i))) - (doc (format "Face for showing items at level %d" 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) @@ -64,7 +138,7 @@ (set sym sym) (setq i (1+ i))))) -(defvar rst-adornment-faces-alist +(defcustom rst-adornment-faces-alist '((1 . rst-level-1-face) (2 . rst-level-2-face) (3 . rst-level-3-face) @@ -73,45 +147,27 @@ (6 . rst-level-6-face) (t . font-lock-keyword-face) (nil . font-lock-keyword-face)) - "An alist mapping adornment types to faces. Key is a number (for faces for -section texts on that level), t (for a face for transitions) or nil (default -face used for section adornment).") + "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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar rst-mode-map nil - "Keymap for rst mode.") +;; FIXME: Code from `restructuredtext.el' should be integrated (defvar rst-mode-syntax-table nil "Syntax table used while in rst mode.") -(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 value of the variable `rst-mode-hook', -if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map rst-mode-map) - (setq mode-name "reST") - (setq major-mode 'rst-mode) -; (setq local-abbrev-table rst-mode-abbrev-table) - (set-syntax-table rst-mode-syntax-table) - (set (make-local-variable 'comment-start) ".. ") - (set (make-local-variable 'indent-line-function) 'indent-relative-maybe) - (set (make-local-variable 'font-lock-multiline) t) - (make-local-variable 'rst-font-lock-adornment-section-alist) - (run-hooks 'rst-mode-hook)) - (unless rst-mode-syntax-table - (setq rst-mode-syntax-table (make-syntax-table (standard-syntax-table))) - (modify-syntax-entry ?\" "." 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) @@ -123,31 +179,90 @@ (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 ()) +(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 -(defvar rst-font-lock-keywords - ;; The rst-links in the following comments all relate to sections in - ;; http://docutils.sourceforge.net/spec/rst/reStructuredText.html +(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/spec/rst/reStructuredText.html (let* ( ;; This gets big - so let's define some abbreviations - ;; all syntax marking up a special block - (face-block '(quote font-lock-keyword-face)) - ;; field names and interpreted text - (face-external '(quote font-lock-type-face)) - ;; all other defining constructs - (face-definition '(quote font-lock-function-name-face)) - ;; directives and roles - (face-directive '(quote font-lock-builtin-face)) - (face-comment '(quote font-lock-comment-face)) - (face-emphasis1 '(quote italic)) - (face-emphasis2 '(quote bold)) - (face-literal '(quote font-lock-string-face)) - ;; references to a definition - (face-reference '(quote font-lock-variable-name-face)) - ;; horizontal white space (re-hws "[\t ]") ;; beginning of line with possible indentation @@ -201,20 +316,20 @@ ;; `Bullet Lists`_ (list (concat re-bol "\\([-*+]" re-blksep1 "\\)") - 1 face-block) + 1 'rst-block-face) ;; `Enumerated Lists`_ (list (concat re-bol "\\((?\\([0-9]+\\|[A-Za-z]\\|[IVXLCMivxlcm]+\\)[.)]" re-blksep1 "\\)") - 1 face-block) + 1 'rst-block-face) ;; `Definition Lists`_ FIXME: missing ;; `Field Lists`_ (list (concat re-bol "\\(:[^:]+:\\)" re-blksep1) - 1 face-external) + 1 'rst-external-face) ;; `Option Lists`_ (list (concat re-bol "\\(\\(\\(\\([-+/]\\|--\\)\\sw\\(-\\|\\sw\\)*\\([ =]\\S +\\)?\\)\\(,[\t ]\\)?\\)+\\)\\($\\|[\t ]\\{2\\}\\)") - 1 face-block) + 1 'rst-block-face) ;; `Tables`_ FIXME: missing @@ -222,66 +337,66 @@ ;; `Footnotes`_ / `Citations`_ (list (concat re-bol "\\(" re-ems "\\[[^[]+\\]\\)" re-blksep1) - 1 face-definition) + 1 'rst-definition-face) ;; `Directives`_ / `Substitution Definitions`_ (list (concat re-bol "\\(" re-ems "\\)\\(\\(|[^|]+|[\t ]+\\)?\\)\\(" re-sym1 "+::\\)" re-blksep1) - (list 1 face-directive) - (list 2 face-definition) - (list 4 face-directive)) + (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 face-definition) + 1 'rst-definition-face) (list (concat re-bol "\\(__\\)" re-blksep1) - 1 face-definition) + 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 face-emphasis2) + 2 'rst-emphasis2-face) ;; `Emphasis`_ (list (concat re-imp1 "\\(\\*" re-ima2 "\\*\\)" re-ims1) - 2 face-emphasis1) + 2 'rst-emphasis1-face) ;; `Inline Literals`_ (list (concat re-imp1 "\\(``" re-imb2 "``\\)" re-ims1) - 2 face-literal) + 2 'rst-literal-face) ;; `Inline Internal Targets`_ (list (concat re-imp1 "\\(_`" re-imb2 "`\\)" re-ims1) - 2 face-definition) + 2 'rst-definition-face) ;; `Hyperlink References`_ ;; FIXME: `Embedded URIs`_ not considered (list (concat re-imp1 "\\(\\(`" re-imb2 "`\\|\\sw+\\)__?\\)" re-ims1) - 2 face-reference) + 2 'rst-reference-face) ;; `Interpreted Text`_ (list (concat re-imp1 "\\(\\(:" re-sym1 "+:\\)?\\)\\(`" re-imb2 "`\\)\\(\\(:" re-sym1 "+:\\)?\\)" re-ims1) - (list 2 face-directive) - (list 5 face-external) - (list 8 face-directive)) + (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 face-reference) + 2 'rst-reference-face) ;; `Substitution References`_ (list (concat re-imp1 "\\(|" re-imv2 "|\\)" re-ims1) - 2 face-reference) + 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 face-definition) + 2 'rst-definition-face) (list (concat re-imp1 "\\(" re-sym1 "+@" re-sym1 "+\\)" re-ims1) - 2 face-definition) + 2 'rst-definition-face) ;; Do all block fontification as late as possible so 'append works @@ -290,7 +405,7 @@ (list re-ado2) (if (not rst-mode-lazy) - (list 1 face-block) + (list 1 'rst-block-face) (list (list 'rst-font-lock-handle-adornment '(progn @@ -299,7 +414,7 @@ nil (list 1 '(cdr (assoc nil rst-adornment-faces-alist)) 'append t) - (list 2 '(cdr (assoc rst-font-lock-section rst-adornment-faces-alist)) + (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))))) @@ -308,7 +423,7 @@ (append (list (concat re-bol "\\(" re-ems "\\)\[^[|_]\\([^:]\\|:\\([^:]\\|$\\)\\)*$") - (list 1 face-comment)) + (list 1 'rst-comment-face)) (if rst-mode-lazy (list (list 'rst-font-lock-find-unindented-line @@ -316,12 +431,12 @@ (setq rst-font-lock-indentation-point (match-end 1)) (point-max)) nil - (list 0 face-comment 'append))))) + (list 0 'rst-comment-face 'append))))) (append (list (concat re-bol "\\(" re-emt "\\)\\(\\s *\\)$") - (list 1 face-comment) - (list 2 face-comment)) + (list 1 'rst-comment-face) + (list 2 'rst-comment-face)) (if rst-mode-lazy (list (list 'rst-font-lock-find-unindented-line @@ -329,13 +444,13 @@ (setq rst-font-lock-indentation-point 'next) (point-max)) nil - (list 0 face-comment 'append))))) + (list 0 'rst-comment-face 'append))))) ;; `Literal Blocks`_ (append (list (concat re-bol "\\(\\([^.\n]\\|\\.[^.\n]\\).*\\)?\\(::\\)$") - (list 3 face-block)) + (list 3 'rst-block-face)) (if rst-mode-lazy (list (list 'rst-font-lock-find-unindented-line @@ -343,19 +458,19 @@ (setq rst-font-lock-indentation-point t) (point-max)) nil - (list 0 face-literal 'append))))) - )) - "Keywords to highlight in rst mode.") + (list 0 'rst-literal-face 'append))))) + ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indented blocks -(defun rst-move-forward-unindented-line (&optional limit column) - "Find the next non-empty line which is not indented at least to COLUMN. -COLUMN defaults to the column of the point. Moves point to first character of -this line and returns that position. Trailing empty lines do not count as being -part of the indented block. If there is no such line before LIMIT returns nil -and point is not moved. LIMIT defaults to (point-max)." +(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)) @@ -370,6 +485,8 @@ (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 @@ -377,12 +494,12 @@ (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'. +;; 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) @@ -411,131 +528,140 @@ (goto-char ind-pnt) ;; Always succeeds because the limit set by PRE-MATCH-FORM is the ;; ultimate point to find - (goto-char (or (rst-move-forward-unindented-line limit) limit)) + (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'. +;; 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-section 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) -; Associates adornments with section levels as encountered while font-locking. -; The key is a two character string. The first character is the adornment -; character. The second character distinguishes underline sections (`u'), -; overline/underline sections (`o'). The value is the section level. -; -; This is made buffer local on start and adornments found during font lock are -; entered. -(defvar rst-font-lock-adornment-section-alist 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. -; Handles adornments for sections and transitions. Returns three match groups. -; First and last match group matched pure adornment while second group matched -; section text. -(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) - (when ado-pnt - (let ((ado-ch (aref (match-string-no-properties 1) 0)) - (ado-re (regexp-quote (match-string-no-properties 1))) +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 - (save-match-data - (or (not (zerop (forward-line 1))) - (looking-at "\\s *$"))))) + (or (not (zerop (forward-line 1))) + (looking-at "\\s *$")))) (prv-emp (save-excursion - (save-match-data - (or (not (zerop (forward-line -1))) - (looking-at "\\s *$"))))) - (beg-pnt - (save-excursion - (forward-line 0) - (point))) - (end-pnt ado-pnt) - beg-ovr end-ovr beg-und end-und ado-key) + (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 rst-font-lock-section t)) + (setq key t) + (setq beg-txt beg-pnt) + (setq end-txt end-pnt)) (prv-emp ;; An overline - (setq ado-key (concat (list ado-ch) "o")) + (setq key (concat (list ado-ch) "o")) (setq beg-ovr beg-pnt) (setq end-ovr end-pnt) - (save-excursion - (save-match-data - (forward-line 1) - (setq beg-pnt (point)) - (setq end-pnt nil) - (while (and (< (point) limit) (not end-pnt)) - (if (looking-at "\\s *$") - ;; No underline found - (setq end-pnt (1- (point))) - (when (looking-at (concat "\\(" ado-re "\\)\\s *$")) - (setq end-und (match-end 1)) - (forward-line 0) - (setq beg-und (point)) - (setq end-pnt (1- beg-und)))) - (forward-line 1))))) + (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 ado-key (concat (list ado-ch) "u")) + (setq key (concat (list ado-ch) "u")) (setq beg-und beg-pnt) (setq end-und end-pnt) - (setq end-pnt (1- beg-und)) - (setq beg-pnt - (save-excursion - (save-match-data - (re-search-backward "^\\s *$" 1 'move) - (forward-line 1) - (point)))))) - (when ado-key - (unless (assoc ado-key rst-font-lock-adornment-section-alist) - (let ((new 1)) - (while (rassoc new rst-font-lock-adornment-section-alist) - (setq new (1+ new))) - (setq rst-font-lock-adornment-section-alist - (append rst-font-lock-adornment-section-alist - (list (cons ado-key new)))))) - (setq rst-font-lock-section - (cdr (assoc ado-key rst-font-lock-adornment-section-alist)))) - (goto-char (or end-und end-pnt end-ovr)) - (set-match-data (list (or beg-ovr beg-pnt beg-und) - (or end-und end-pnt end-und) - beg-ovr end-ovr beg-pnt end-pnt beg-und end-und)) + (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 has its own mind about font-lock-support-mode -(if (boundp 'font-lock-support-mode) - (cond - ((and (not rst-mode-lazy) (not font-lock-support-mode))) - ;; No support mode set and none wanted - leave it alone - ((or (not font-lock-support-mode) ;; No support mode set (but wanted) - (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))))) - -(if (string-match "XEmacs\\|Lucid" emacs-version) - (put 'rst-mode 'font-lock-defaults '(rst-font-lock-keywords t)) - (setq font-lock-defaults-alist - (append '((rst-mode rst-font-lock-keywords t)) - font-lock-defaults-alist))) ;;; rst-mode.el ends here |