Mercurial > emacs
changeset 96126:fcd827c4a553
Fix up docstring conventions.
Move vars to before their first use.
(rst-mode): Don't mess with font-lock-support-mode.
(rst-suggest-new-decoration, rst-adjust-decoration):
Avoid CL's copy-list.
(rst-delete-entire-line): Use line-beginning-position.
(rst-position): New fun.
(rst-straighten-decorations): Use it instead of CL's position.
(rst-straighten-bullets-region): Avoid CL's mapcar*.
(rst-toc-mode): Use define-derived-mode.
(rst-iterate-leftmost-paragraphs, rst-iterate-leftmost-paragraphs-2):
Remove unused var `in-par'. Use `point' rather than `point-marker'.
(rst-line-block-region): Reduce redundancy. Use the `pfxarg' arg.
(rst-replace-lines): Simplify.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Fri, 20 Jun 2008 17:53:42 +0000 |
parents | 673e286487b1 |
children | 8b630d07bb3f |
files | lisp/ChangeLog lisp/textmodes/rst.el |
diffstat | 2 files changed, 316 insertions(+), 316 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Fri Jun 20 17:16:41 2008 +0000 +++ b/lisp/ChangeLog Fri Jun 20 17:53:42 2008 +0000 @@ -1,5 +1,20 @@ 2008-06-20 Stefan Monnier <monnier@iro.umontreal.ca> + * textmodes/rst.el: Fix up docstring conventions. + Move vars to before their first use. + (rst-mode): Don't mess with font-lock-support-mode. + (rst-suggest-new-decoration, rst-adjust-decoration): + Avoid CL's copy-list. + (rst-delete-entire-line): Use line-beginning-position. + (rst-position): New fun. + (rst-straighten-decorations): Use it instead of CL's position. + (rst-straighten-bullets-region): Avoid CL's mapcar*. + (rst-toc-mode): Use define-derived-mode. + (rst-iterate-leftmost-paragraphs, rst-iterate-leftmost-paragraphs-2): + Remove unused var `in-par'. Use `point' rather than `point-marker'. + (rst-line-block-region): Reduce redundancy. Use the `pfxarg' arg. + (rst-replace-lines): Simplify. + * simple.el (special-mode-map): New var. (special-mode): New major mode.
--- a/lisp/textmodes/rst.el Fri Jun 20 17:16:41 2008 +0000 +++ b/lisp/textmodes/rst.el Fri Jun 20 17:53:42 2008 +0000 @@ -25,10 +25,10 @@ ;;; Commentary: ;; This package provides major mode rst-mode, which supports 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: rst-mode (ReST). This mode is derived from text-mode (and -;; inherits much of it). This package also contains: +;; 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: rst-mode (ReST). This mode is derived from text-mode (and +;; inherits much of it). This package also contains: ;; ;; - Functions to automatically adjust and cycle the section underline ;; decorations; @@ -49,17 +49,17 @@ ;; http://docutils.sourceforge.net/docs/user/emacs.html ;; ;; -;; There are a number of convenient keybindings provided by rst-mode. The main -;; one is +;; There are a number of convenient keybindings provided by rst-mode. +;; The main one is ;; ;; C-c C-a (also C-=): rst-adjust ;; ;; Updates or rotates the section title around point or promotes/demotes the -;; decorations within the region (see full details below). Note that C-= is a +;; decorations within the region (see full details below). Note that C-= is a ;; good binding, since it allows you to specify a negative arg easily with C-- ;; C-= (easy to type), as well as ordinary prefix arg with C-u C-=. ;; -;; For more on bindings, see rst-mode-map below. There are also many variables +;; For more on bindings, see rst-mode-map below. There are also many variables ;; that can be customized, look for defcustom and defvar in this file. ;; ;; If you use the table-of-contents feature, you may want to add a hook to @@ -67,8 +67,8 @@ ;; ;; (add-hook 'rst-adjust-hook 'rst-toc-update) ;; -;; Syntax highlighting: font-lock is enabled by default. If you want to turn off -;; syntax highlighting to rst-mode, you can use the following:: +;; Syntax highlighting: font-lock is enabled by default. If you want to turn +;; off syntax highlighting to rst-mode, you can use the following:: ;; ;; (setq font-lock-global-modes '(not rst-mode ...)) ;; @@ -84,7 +84,7 @@ ;; ;; rst-faces ;; --------- -;; This group contains all necessary for customizing fonts. The default +;; This group contains all necessary for customizing fonts. The default ;; settings use standard font-lock-*-face's so if you set these to your ;; liking they are probably good in rst-mode also. ;; @@ -96,21 +96,21 @@ ;; 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 +;; 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 +;; 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 ;; rst-adornment-faces-alist. ;; ;; Note: If you are using a dark background please make sure the variable -;; frame-background-mode is set to the symbol dark. This triggers +;; frame-background-mode is set to the symbol dark. This triggers ;; some default values which are probably right for you. ;; ;; The group is contained in the rst-faces group. ;; -;; All customizable features have a comment explaining their meaning. Refer to -;; the customization of your Emacs (try ``M-x customize``). +;; All customizable features have a comment explaining their meaning. +;; Refer to the customization of your Emacs (try ``M-x customize``). ;;; DOWNLOAD @@ -128,12 +128,12 @@ ;; 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:: +;; provides to set the major mode automatically. For instance you may use:: ;; ;; .. -*- mode: rst -*- ;; -;; in the very first line of your file. The following code is useful if you want -;; to automatically enter rst-mode from any file with compatible extensions: +;; in the very first line of your file. The following code is useful if you +;; want automatically enter rst-mode from any file with compatible extensions: ;; ;; (setq auto-mode-alist ;; (append '(("\\.txt$" . rst-mode) @@ -196,7 +196,7 @@ ;;; HISTORY ;; -;;; CODE +;;; Code: (defgroup rst nil "Support for reStructuredText documents" @@ -302,7 +302,8 @@ (define-key map [(control c) (?5)] 'rst-compile-slides-preview) map) - "Keymap for ReStructuredText mode commands. This inherits from Text mode.") + "Keymap for ReStructuredText mode commands. +This inherits from Text mode.") ;; Abbrevs. @@ -343,18 +344,18 @@ (defcustom rst-mode-hook nil - "Hook run when Rst Mode is turned on. The hook for Text Mode is run before - this one." + "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. + "*If non-nil Rst Mode tries to font-lock multi-line elements correctly. +Because this is really slow it should be set to nil if neither `jit-lock-mode' +not `lazy-lock-mode' and activated. + +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 @@ -405,33 +406,35 @@ 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) - ;; jit-lock-mode replaced lazy-lock-mode in GNU Emacs 22 - (let ((jit-or-lazy-lock-mode - (cond - ((fboundp 'lazy-lock-mode) 'lazy-lock-mode) - ((fboundp 'jit-lock-mode) 'jit-lock-mode) - ;; if neither lazy-lock nor jit-lock is supported, - ;; tell user and disable rst-mode-lazy - (t (when rst-mode-lazy - (message "Disabled lazy fontification, because no known support mode found.") - (setq rst-mode-lazy nil)))))) - (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 jit-or-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 - (cons (cons 'rst-mode (and rst-mode-lazy jit-or-lazy-lock-mode)) - font-lock-support-mode)))))) + ;; `jit-lock-mode' has been the default since Emacs-21.1, so there's no + ;; point messing around with font-lock-support-mode any more. + ;; (when (boundp 'font-lock-support-mode) + ;; ;; rst-mode has its own mind about font-lock-support-mode + ;; (make-local-variable 'font-lock-support-mode) + ;; ;; jit-lock-mode replaced lazy-lock-mode in GNU Emacs 21. + ;; (let ((jit-or-lazy-lock-mode + ;; (cond + ;; ((fboundp 'lazy-lock-mode) 'lazy-lock-mode) + ;; ((fboundp 'jit-lock-mode) 'jit-lock-mode) + ;; ;; if neither lazy-lock nor jit-lock is supported, + ;; ;; tell user and disable rst-mode-lazy + ;; (t (when rst-mode-lazy + ;; (message "Disabled lazy fontification, because no known support mode found.") + ;; (setq rst-mode-lazy nil)))))) + ;; (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 jit-or-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 + ;; (cons (cons 'rst-mode (and rst-mode-lazy jit-or-lazy-lock-mode)) + ;; font-lock-support-mode)))))) ) @@ -675,12 +678,12 @@ (setq curpotential (cdr curpotential))) - (copy-list (car curpotential)) )) + (copy-sequence (car curpotential)))) (defun rst-delete-entire-line () "Delete the entire current line without using the `kill-ring'." - (delete-region (line-beginning-position) (min (+ 1 (line-end-position)) - (point-max)))) + (delete-region (line-beginning-position) + (line-beginning-position 2))) (defun rst-update-section (char style &optional indent) "Unconditionally update the style of a section decoration. @@ -1065,10 +1068,11 @@ "Hooks to be run after running `rst-adjust'.") (defvar rst-new-decoration-down nil - "If true, a new decoration being added will be initialized to - be one level down from the previous decoration. If nil, a new - decoration will be equal to the level of the previous - decoration.") + "Non-nil if new decoration is added deeper. +If non-nil, a new decoration being added will be initialized to +be one level down from the previous decoration. If nil, a new +decoration will be equal to the level of the previous +decoration.") (defun rst-adjust-decoration (&optional toggle-style reverse-direction) "Adjust/rotate the section decoration for the section title around point. @@ -1284,8 +1288,7 @@ (rst-get-decoration-match hier prev)) (rst-suggest-new-decoration hier prev)) prev) - (copy-list (car rst-preferred-decorations)) - )) + (copy-sequence (car rst-preferred-decorations)))) ;; Invert the style if requested. (if toggle-style @@ -1440,6 +1443,11 @@ )) ))) +(defun rst-position (elem list) + "Return position of ELEM in LIST or nil." + (let ((tail (member elem list))) + (if tail (- (length list) (length tail))))) + (defun rst-straighten-decorations () "Redo all the decorations in the current buffer. This is done using our preferred set of decorations. This can be @@ -1453,7 +1461,7 @@ ;; Get a list of pairs of (level . marker) (levels-and-markers (mapcar (lambda (deco) - (cons (position (cdr deco) hier :test 'equal) + (cons (rst-position (cdr deco) hier) (let ((m (make-marker))) (goto-line (car deco)) (set-marker m (point)) @@ -1515,8 +1523,8 @@ (> (current-column) pfx-col) (and (= (current-column) pfx-col) (looking-at pfx-re)))))) - (setq pfx (cons (cons (point) (current-column)) - pfx))) + (push (cons (point) (current-column)) + pfx)) (forward-line 1)) ) (nreverse pfx))) @@ -1562,23 +1570,18 @@ levtable))) ;; Sort this map and create a new map of prefix char and list of positions. - (let (poslist) - (maphash (lambda (x y) (setq poslist (cons (cons x y) poslist))) levtable) - - (mapcar* (lambda (x char) - ;; Apply the characters. - (dolist (pos (cdr x)) - (goto-char pos) - (delete-char 1) - (insert (char-to-string char)))) - - ;; Sorted list of indent . positions - (sort poslist (lambda (x y) (<= (car x) (car y)))) - - ;; List of preferred bullets. - rst-preferred-bullets) - - ))) + (let ((poslist ())) ; List of (indent . positions). + (maphash (lambda (x y) (push (cons x y) poslist)) levtable) + + (let ((bullets rst-preferred-bullets)) + (dolist (x (sort poslist 'car-less-than-car)) + (when bullets + ;; Apply the characters. + (dolist (pos (cdr x)) + (goto-char pos) + (delete-char 1) + (insert (string (car bullets)))) + (setq bullets (cdr bullets)))))))) (defun rst-rstrip (str) "Strips the whitespace at the end of string STR." @@ -1711,6 +1714,42 @@ )) +(defgroup rst-toc nil + "Settings for reStructuredText table of contents." + :group 'rst + :version "21.1") + +(defcustom rst-toc-indent 2 + "Indentation for table-of-contents display. +Also used for formatting insertion, when numbering is disabled." + :group 'rst-toc) + +(defcustom rst-toc-insert-style 'fixed + "Insertion style for table-of-contents. +Set this to one of the following values to determine numbering and +indentation style: +- plain: no numbering (fixed indentation) +- fixed: numbering, but fixed indentation +- aligned: numbering, titles aligned under each other +- listed: numbering, with dashes like list items (EXPERIMENTAL)" + :group 'rst-toc) + +(defcustom rst-toc-insert-number-separator " " + "Separator that goes between the TOC number and the title." + :group 'rst-toc) + +;; This is used to avoid having to change the user's mode. +(defvar rst-toc-insert-click-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'rst-toc-mode-mouse-goto) + map) + "(Internal) What happens when you click on propertized text in the TOC.") + +(defcustom rst-toc-insert-max-level nil + "If non-nil, maximum depth of the inserted TOC." + :group 'rst-toc) + + (defun rst-toc-insert (&optional pfxarg) "Insert a simple text rendering of the table of contents. By default the top level is ignored if there is only one, because @@ -1747,42 +1786,6 @@ (delete-backward-char 1) ))) - -(defgroup rst-toc nil - "Settings for reStructuredText table of contents." - :group 'rst - :version "21.1") - -(defcustom rst-toc-indent 2 - "Indentation for table-of-contents display. -Also used for formatting insertion, when numbering is disabled." - :group 'rst-toc) - -(defcustom rst-toc-insert-style 'fixed - "Insertion style for table-of-contents. -Set this to one of the following values to determine numbering and -indentation style: -- plain: no numbering (fixed indentation) -- fixed: numbering, but fixed indentation -- aligned: numbering, titles aligned under each other -- listed: numbering, with dashes like list items (EXPERIMENTAL)" - :group 'rst-toc) - -(defcustom rst-toc-insert-number-separator " " - "Separator that goes between the TOC number and the title." - :group 'rst-toc) - -;; This is used to avoid having to change the user's mode. -(defvar rst-toc-insert-click-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'rst-toc-mode-mouse-goto) - map) - "(Internal) What happens when you click on propertized text in the TOC.") - -(defcustom rst-toc-insert-max-level nil - "If non-nil, maximum depth of the inserted TOC." - :group 'rst-toc) - (defun rst-toc-insert-node (node level indent pfx) "Insert tree node NODE in table-of-contents. Recursive function that does printing of the inserted toc. LEVEL @@ -1966,6 +1969,12 @@ child (cdr child)))))) (cons count found))) +(defvar rst-toc-buffer-name "*Table of Contents*" + "Name of the Table of Contents buffer.") + +(defvar rst-toc-return-buffer nil + "Buffer to which to return when leaving the TOC.") + (defun rst-toc () "Display a table-of-contents. @@ -2023,9 +2032,6 @@ (error "Buffer for this section was killed")) pos)) -(defvar rst-toc-buffer-name "*Table of Contents*" - "Name of the Table of Contents buffer.") - (defun rst-goto-section (&optional kill) "Go to the section the current line describes." (interactive) @@ -2047,8 +2053,7 @@ EVENT is the input event." (interactive "e") (let (pos) - (save-excursion - (set-buffer (window-buffer (posn-window (event-end event)))) + (with-current-buffer (window-buffer (posn-window (event-end event))) (save-excursion (goto-char (posn-point (event-end event))) (setq pos (rst-toc-mode-find-section)))) @@ -2057,15 +2062,13 @@ (recenter 5))) (defun rst-toc-mode-mouse-goto-kill (event) + "Same as `rst-toc-mode-mouse-goto', but kill TOC buffer as well." (interactive "e") (call-interactively 'rst-toc-mode-mouse-goto event) (kill-buffer (get-buffer rst-toc-buffer-name))) -(defvar rst-toc-return-buffer nil - "Buffer local variable that is used to return to the original - buffer from the TOC.") - (defun rst-toc-quit-window () + "Leave the current TOC buffer." (interactive) (quit-window) (pop-to-buffer rst-toc-return-buffer)) @@ -2083,15 +2086,10 @@ (put 'rst-toc-mode 'mode-class 'special) -(defun rst-toc-mode () +;; Could inherit from the new `special-mode'. +(define-derived-mode rst-toc-mode nil "ReST-TOC" "Major mode for output from \\[rst-toc], the table-of-contents for the document." - (interactive) - (kill-all-local-variables) - (use-local-map rst-toc-mode-map) - (setq major-mode 'rst-toc-mode) - (setq mode-name "ReST-TOC") - (setq buffer-read-only t) - ) + (setq buffer-read-only t)) ;; Note: use occur-mode (replace.el) as a good example to complete missing ;; features. @@ -2104,8 +2102,8 @@ (defun rst-forward-section (&optional offset) "Skip to the next restructured text section title. - OFFSET specifies how many titles to skip. Use a negative OFFSET to move - backwards in the file (default is to use 1)." +OFFSET specifies how many titles to skip. Use a negative OFFSET to move +backwards in the file (default is to use 1)." (interactive) (let* (;; Default value for offset. (offset (or offset 1)) @@ -2141,7 +2139,7 @@ )) (defun rst-backward-section () - "Like rst-forward-section, except move back one title. + "Like `rst-forward-section', except move back one title. With a prefix argument, move backward by a page." (interactive) (rst-forward-section -1)) @@ -2177,11 +2175,10 @@ ;; (FIXME: there is currently a bug that makes the region go away when we do that.) (defvar rst-shift-fill-region nil - "Set to true if you want to automatically re-fill the region that is being -shifted.") + "If non-nil, automatically re-fill the region that is being shifted.") (defun rst-find-leftmost-column (beg end) - "Finds the leftmost column in the region." + "Find the leftmost column in the region." (let ((mincol 1000)) (save-excursion (goto-char beg) @@ -2213,11 +2210,12 @@ ;; positions, in case the line matches the bullet pattern, and then sort. (defun rst-compute-bullet-tabs (&optional pt) - "Search backwards from point (or point PT if specified) to + "Build the list of possible horizontal alignment points. +Search backwards from point (or point PT if specified) to build the list of possible horizontal alignment points that includes the beginning and contents of a restructuredtext bulleted or enumerated list item. Return a sorted list -of (column-number . line) pairs." +of (COLUMN-NUMBER . LINE) pairs." (save-excursion (when pt (goto-char pt)) @@ -2245,7 +2243,7 @@ ;; Add the beginning of the line as a tabbing point. (unless (memq col (mapcar 'car tablist)) - (setq tablist (cons (cons col (point)) tablist))) + (push (cons col (point)) tablist)) ;; Look at the line to figure out if it is a bulleted or enumerate ;; list item. @@ -2264,9 +2262,8 @@ (newcol (+ col matchlen))) (unless (or (>= newcol leftcol) (memq (+ col matchlen) (mapcar 'car tablist))) - (setq tablist (cons - (cons (+ col matchlen) (+ (point) matchlen)) - tablist)))) + (push (cons (+ col matchlen) (+ (point) matchlen)) + tablist))) ) (setq leftcol col) @@ -2279,8 +2276,7 @@ ))) (defun rst-debug-print-tabs (tablist) - "A routine that inserts a line and places special characters at -the tab points in the given tablist." + "Insert a line and place special characters at the tab points in TABLIST." (beginning-of-line) (insert (concat "\n" (make-string 1000 ? ) "\n")) (beginning-of-line 0) @@ -2292,8 +2288,7 @@ )) (defun rst-debug-mark-found (tablist) - "A routine that inserts a line and places special characters at -the tab points in the given tablist." + "Insert a line and place special characters at the tab points in TABLIST." (dolist (col tablist) (when (cdr col) (goto-char (cdr col)) @@ -2304,7 +2299,7 @@ "Basic horizontal shift distance when there is no preceding alignment tabs.") (defun rst-shift-region-guts (find-next-fun offset-fun) - "(See rst-shift-region-right for a description.)" + "(See `rst-shift-region-right' for a description)." (let* ((mbeg (set-marker (make-marker) (region-beginning))) (mend (set-marker (make-marker) (region-end))) (tabs (rst-compute-bullet-tabs mbeg)) @@ -2361,12 +2356,12 @@ )) (defun rst-shift-region-right (pfxarg) - "Indent region ridigly, by a few characters to the right. This -function first computes all possible alignment columns by + "Indent region ridigly, by a few characters to the right. +This function first computes all possible alignment columns by inspecting the lines preceding the region for bulleted or enumerated list items. If the leftmost column is beyond the preceding lines, the region is moved to the right by -rst-shift-basic-offset. With a prefix argument, do not +`rst-shift-basic-offset'. With a prefix argument, do not automatically fill the region." (interactive "P") (let ((rst-shift-fill-region @@ -2380,7 +2375,7 @@ ))) (defun rst-shift-region-left (pfxarg) - "Like rst-shift-region-right, except we move to the left. + "Like `rst-shift-region-right', except we move to the left. Also, if invoked with a negative prefix arg, the entire indentation is removed, up to the leftmost character in the region, and automatic filling is disabled." @@ -2408,6 +2403,84 @@ )) ))) +(defmacro rst-iterate-leftmost-paragraphs + (beg end first-only body-consequent body-alternative) + "FIXME This definition is old and deprecated / we need to move +to the newer version below: + +Call FUN at the beginning of each line, with an argument that +specifies whether we are at the first line of a paragraph that +starts at the leftmost column of the given region BEG and END. +Set FIRST-ONLY to true if you want to callback on the first line +of each paragraph only." + `(save-excursion + (let ((leftcol (rst-find-leftmost-column ,beg ,end)) + (endm (set-marker (make-marker) ,end)) + ) + + (do* (;; Iterate lines + (l (progn (goto-char ,beg) (back-to-indentation)) + (progn (forward-line 1) (back-to-indentation))) + + (previous nil valid) + + (curcol (current-column) + (current-column)) + + (valid (and (= curcol leftcol) + (not (looking-at "[ \t]*$"))) + (and (= curcol leftcol) + (not (looking-at "[ \t]*$")))) + ) + ((>= (point) endm)) + + (if (if ,first-only + (and valid (not previous)) + valid) + ,body-consequent + ,body-alternative) + + )))) + + +(defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body) + "Evaluate BODY for each line in region defined by BEG END. +LEFTMOST is set to true if the line is one of the leftmost of the +entire paragraph. PARABEGIN is set to true if the line is the +first of a paragraph." + (declare (indent 1) (debug (sexp body))) + (destructuring-bind + (beg end parabegin leftmost isleftmost isempty) spec + + `(save-excursion + (let ((,leftmost (rst-find-leftmost-column ,beg ,end)) + (endm (set-marker (make-marker) ,end)) + ) + + (do* (;; Iterate lines + (l (progn (goto-char ,beg) (back-to-indentation)) + (progn (forward-line 1) (back-to-indentation))) + + (empty-line-previous nil ,isempty) + + (,isempty (looking-at "[ \t]*$") + (looking-at "[ \t]*$")) + + (,parabegin (not ,isempty) + (and empty-line-previous + (not ,isempty))) + + (,isleftmost (and (not ,isempty) + (= (current-column) ,leftmost)) + (and (not ,isempty) + (= (current-column) ,leftmost))) + ) + ((>= (point) endm)) + + (progn ,@body) + + ))))) + ;;------------------------------------------------------------------------------ @@ -2443,85 +2516,6 @@ (insert " ") )) -(defmacro rst-iterate-leftmost-paragraphs - (beg end first-only body-consequent body-alternative) - "FIXME This definition is old and deprecated / we need to move -to the newer version below: - -Call FUN at the beginning of each line, with an argument that -specifies whether we are at the first line of a paragraph that -starts at the leftmost column of the given region BEG and END. -Set FIRST-ONLY to true if you want to callback on the first line -of each paragraph only." - `(save-excursion - (let ((leftcol (rst-find-leftmost-column ,beg ,end)) - (endm (set-marker (make-marker) ,end)) - ,(when first-only '(in-par nil)) - ) - - (do* (;; Iterate lines - (l (progn (goto-char ,beg) (back-to-indentation)) - (progn (forward-line 1) (back-to-indentation))) - - (previous nil valid) - - (curcol (current-column) - (current-column)) - - (valid (and (= curcol leftcol) - (not (looking-at "[ \t]*$"))) - (and (= curcol leftcol) - (not (looking-at "[ \t]*$")))) - ) - ((>= (point-marker) endm)) - - (if (if ,first-only - (and valid (not previous)) - valid) - ,body-consequent - ,body-alternative) - - )))) - - -(defmacro rst-iterate-leftmost-paragraphs-2 (spec &rest body) - "Evaluate BODY for each line in region defined by BEG END. -LEFTMOST is set to true if the line is one of the leftmost of the -entire paragraph. PARABEGIN is set to true if the line is the -first of a paragraph." - (destructuring-bind - (beg end parabegin leftmost isleftmost isempty) spec - - `(save-excursion - (let ((,leftmost (rst-find-leftmost-column ,beg ,end)) - (endm (set-marker (make-marker) ,end)) - (in-par nil) - ) - - (do* (;; Iterate lines - (l (progn (goto-char ,beg) (back-to-indentation)) - (progn (forward-line 1) (back-to-indentation))) - - (empty-line-previous nil ,isempty) - - (,isempty (looking-at "[ \t]*$") - (looking-at "[ \t]*$")) - - (,parabegin (not ,isempty) - (and empty-line-previous - (not ,isempty))) - - (,isleftmost (and (not ,isempty) - (= (current-column) ,leftmost)) - (and (not ,isempty) - (= (current-column) ,leftmost))) - ) - ((>= (point-marker) endm)) - - (progn ,@body) - - ))))) - ;; FIXME: there are some problems left with the following function ;; implementation: @@ -2533,7 +2527,7 @@ (defun rst-convert-bullets-to-enumeration (beg end) "Convert all the bulleted items and enumerated items in the - region to enumerated lists, renumbering as necessary." +region to enumerated lists, renumbering as necessary." (interactive "r") (let* (;; Find items and convert the positions to markers. (items (mapcar @@ -2559,26 +2553,20 @@ ;;------------------------------------------------------------------------------ (defun rst-line-block-region (rbeg rend &optional pfxarg) - "Toggle line block prefixes for a region. With prefix argument -set the empty lines too." + "Toggle line block prefixes for a region. +With prefix argument set the empty lines too." (interactive "r\nP") (let ((comment-start "| ") (comment-end "") (comment-start-skip "| ") (comment-style 'indent) - (force current-prefix-arg)) + (force (not (not pfxarg)))) (rst-iterate-leftmost-paragraphs-2 - (rbeg rend parbegin leftmost isleft isempty) - (if force - (progn - (move-to-column leftmost t) - (delete-region (point) (+ (point) (- (current-indentation) leftmost))) - (insert "| ")) - (when (not isempty) - (move-to-column leftmost) - (delete-region (point) (+ (point) (- (current-indentation) leftmost))) - (insert "| "))) - ))) + (rbeg rend parbegin leftmost isleft isempty) + (when (or force (not isempty)) + (move-to-column leftmost force) + (delete-region (point) (+ (point) (- (current-indentation) leftmost))) + (insert "| "))))) @@ -2592,17 +2580,17 @@ :version "21.1") (defcustom rst-block-face 'font-lock-keyword-face - "All syntax marking up a special block" + "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" + "Field names and interpreted text." :group 'rst-faces :type '(face)) (defcustom rst-definition-face 'font-lock-function-name-face - "All other defining constructs" + "All other defining constructs." :group 'rst-faces :type '(face)) @@ -2611,12 +2599,12 @@ (if (boundp 'font-lock-builtin-face) 'font-lock-builtin-face 'font-lock-preprocessor-face) - "Directives and roles" + "Directives and roles." :group 'rst-faces :type '(face)) (defcustom rst-comment-face 'font-lock-comment-face - "Comments" + "Comments." :group 'rst-faces :type '(face)) @@ -2625,7 +2613,7 @@ (if (facep 'italic) ''italic 'italic) - "Simple emphasis" + "Simple emphasis." :group 'rst-faces :type '(face)) @@ -2634,17 +2622,17 @@ (if (facep 'bold) ''bold 'bold) - "Double emphasis" + "Double emphasis." :group 'rst-faces :type '(face)) (defcustom rst-literal-face 'font-lock-string-face - "Literal text" + "Literal text." :group 'rst-faces :type '(face)) (defcustom rst-reference-face 'font-lock-variable-name-face - "References to a definition" + "References to a definition." :group 'rst-faces :type '(face)) @@ -2657,26 +2645,8 @@ :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." + "Set custom var SYM 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) @@ -2684,6 +2654,7 @@ (boundp 'rst-level-face-base-color) (boundp 'rst-level-face-step-light) (boundp 'rst-level-face-base-light) + (fboundp 'rst-define-level-faces) (rst-define-level-faces))) ;; Faces for displaying items on several levels; these definitions define @@ -2704,9 +2675,9 @@ (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." + "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) @@ -2720,7 +2691,8 @@ (if (eq frame-background-mode 'dark) 7 -7) - "The step width to use for the next color. The formula + "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' @@ -2741,10 +2713,11 @@ (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 + "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 @@ -2757,6 +2730,23 @@ :value-type (face)) :set-after '(rst-level-face-max)) +(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)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2767,7 +2757,7 @@ "Non-nil if we can use the character classes in our regexps.") (defun rst-font-lock-keywords-function () - "Returns keywords to highlight in rst mode according to current settings." + "Return 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 @@ -2990,8 +2980,8 @@ (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 +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) @@ -3077,9 +3067,9 @@ ;; 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. +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.") @@ -3203,7 +3193,8 @@ (newlatex . ("rst2newlatex.py" ".tex" nil)) (pseudoxml . ("rst2pseudoxml.py" ".xml" nil)) (xml . ("rst2xml.py" ".xml" nil))) - "An association list of the toolset to a list of the (command to use, + "Table describing the command to use for each toolset. +An association list of the toolset to a list of the (command to use, extension of produced filename, options to the tool (nil or a string)) to be used for converting the document.") @@ -3214,10 +3205,10 @@ (defvar rst-compile-primary-toolset 'html - "The default toolset for rst-compile.") + "The default toolset for `rst-compile'.") (defvar rst-compile-secondary-toolset 'latex - "The default toolset for rst-compile with a prefix argument.") + "The default toolset for `rst-compile' with a prefix argument.") (defun rst-compile-find-conf () "Look for the configuration file in the parents of the current path." @@ -3286,8 +3277,8 @@ (rst-compile 't)) (defun rst-compile-pseudo-region () - "Show the pseudo-XML rendering of the current active region, or -of the entire buffer, if the region is not selected." + "Show the pseudo-XML rendering of the current active region, +or of the entire buffer, if the region is not selected." (interactive) (with-output-to-temp-buffer "*pseudoxml*" (shell-command-on-region @@ -3340,21 +3331,15 @@ 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))) - (rst-delete-entire-line) - (insert-char tochar l)) - (search-failed - (message (format "%d lines replaced." found))))))) + (let ((searchre (concat "^" (regexp-quote (string fromchar)) "+\\( *\\)$")) + (found 0)) + (while (search-forward-regexp searchre nil t) + (setq found (1+ found)) + (goto-char (match-beginning 1)) + (let ((width (current-column))) + (rst-delete-entire-line) + (insert-char tochar width))) + (message (format "%d lines replaced." found))))) (defun rst-join-paragraph () "Join lines in current paragraph into one line, removing end-of-lines." @@ -3376,7 +3361,7 @@ (defun rst-repeat-last-character (&optional tofill) "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, we use the fill-column. +empty, we use the `fill-column'. If a prefix argument is provided, use the next line rather than the preceding line.