[Docutils-checkins] r3855 - in branches/better-emacs/emacs: restructuredtext.el tests/tests-adjust-section.el tests/tests-basic.el tests/tests-runner.el

[<bl...@us...>]

Author: blais
Date: 2005-09-07 20:59:48 +0200 (Wed, 07 Sep 2005)
New Revision: 3855

Modified:
   branches/better-emacs/emacs/restructuredtext.el
   branches/better-emacs/emacs/tests/tests-adjust-section.el
   branches/better-emacs/emacs/tests/tests-basic.el
   branches/better-emacs/emacs/tests/tests-runner.el
Log:
Almost done with new emacs underlining support.

Modified: branches/better-emacs/emacs/restructuredtext.el
===================================================================
--- branches/better-emacs/emacs/restructuredtext.el	2005-09-06 14:55:48 UTC (rev 3854)
+++ branches/better-emacs/emacs/restructuredtext.el	2005-09-07 18:59:48 UTC (rev 3855)
@@ -17,7 +17,10 @@
 ;; hook. Something like this::
 ;;
 ;;   (defun user-rst-mode-hook ()
-;;     (local-set-key [(control ?=)] 'rest-adjust-section-title)
+;;      (local-set-key [(control ?=)] 
+;;                     'rest-adjust-section-decoration)
+;;      (local-set-key [(control x) (control ?=)] 
+;;                     'rest-display-sections-hierarchy)
 ;;     )
 ;;   (add-hook 'text-mode-hook 'user-rst-mode-hook)
 ;;
@@ -40,104 +43,9 @@
                 (cons head tail)
               tail)))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Generic text functions that are more convenient than the defaults.
-;;
 
-(defun replace-lines (fromchar tochar)
-  "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 join-paragraph ()
-  "Join lines in current paragraph into one line, removing end-of-lines."
-  (interactive)
-  (let ((fill-column 65000)) ; some big number
-    (call-interactively 'fill-paragraph)))
-
-(defun force-fill-paragraph ()
-  "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))
-
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
-;; Generic character repeater function.
-;;
-;; For sections, better to use the specialized function above, but this can
-;; be useful for creating separators.
-
-(defun 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.
-
-If a prefix argument is provided, use the next line rather than the preceding
-line.
-
-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
-column is used (fill-column vs. end of previous/next line)."
-  (interactive)
-  (let* ((curcol (current-column))
-         (curline (+ (count-lines (point-min) (point))
-                     (if (eq curcol 0) 1 0)))
-         (lbp (line-beginning-position 0))
-         (prevcol (if (and (= curline 1) (not current-prefix-arg))
-                      fill-column
-                    (save-excursion
-                      (forward-line (if current-prefix-arg 1 -1))
-                      (end-of-line)
-                      (skip-chars-backward " \t" lbp)
-                      (let ((cc (current-column)))
-                        (if (= cc 0) fill-column cc)))))
-         (rightmost-column
-          (cond (tofill 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))))
-    ))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
 ;; The following functions implement a smart automatic title sectioning feature.
 ;; The idea is that with the cursor sitting on a section title, we try to get as
 ;; much information from context and try to do the best thing automatically.
@@ -208,10 +116,36 @@
 ;; adjustment (unless we cycle, in which case we use the indent that has been
 ;; found previously).
 
+(defcustom rest-preferred-decorations '( (?= over-and-under 1)
+					 (?= simple 0)
+					 (?- simple 0)
+					 (?~ simple 0)
+					 (?+ simple 0)
+					 (?` simple 0)
+					 (?# simple 0)
+					 (?@ simple 0) )
+  "Preferred ordering of section title decorations.  This
+  sequence is consulted to offer a new decoration suggestion when
+  we rotate the underlines at the end of the existing hierarchy
+  of characters, or when there is no existing section title in
+  the file.")
+
+
+(defcustom rest-default-indent 1
+  "Number of characters to indent the section title when toggling
+  decoration styles.  This is used when switching from a simple
+  decoration style to a over-and-under decoration style.")
+
+
+(defcustom rest-section-text-regexp "^[ \t]*\\S-+"
+  "Regular expression for valid section title text.")
+
+
 (defun rest-current-line ()
   "Returns the current line number."
   (+ (count-lines (point-min) (point)) (if (bolp) 1 0)))
 
+
 (defun rest-line-homogeneous-p (&optional accept-special)
   "Predicate return the unique char if the current line is
   composed only of a single repeated non-whitespace
@@ -239,97 +173,37 @@
           ))
     ))
 
-(defun rest-find-last-section-char ()
-  "Looks backward in the file for the character from the last
-decoration before point."
-  (let (c)
-    (save-excursion
-      (while (and (not c) (not (bobp)))
-        (forward-line -1)
-        (setq c (rest-line-homogeneous-p))
-        ))
-    c))
 
-(defun rest-current-section-char (&optional point)
-  "Gets the character from the decoration around the current
-point."
-  (save-excursion
-    (if point (goto-char point))
-    (let ((offlist '(0 1 -2))
-          loff
-          rval
-          c)
-      (while offlist
-        (forward-line (car offlist))
-        (setq c (rest-line-homogeneous-p 1))
-        (if c
-            (progn (setq offlist nil
-                         rval c))
-          (setq offlist (cdr offlist)))
-        )
-      rval
-      )))
+(defun rest-compare-decorations (deco1 deco2)
+  "Compare decorations.  Returns true if both are equal,
+according to restructured text semantics (only the character and
+the style are compared, the indentation does not matter."
+  (and (eq (car deco1) (car deco2))
+       (eq (cadr deco1) (cadr deco2))))
 
-(defun rest-initial-sectioning-style (&optional point)
-  "Looks around point and attempts to determine the sectioning style,
-  between simple and over-and-under.  If a decoration cannot be
-  found, return nil."
-  (save-excursion
-    (if point (goto-char point))
-    (let (ou)
-      (save-excursion
-        (setq ou (mapcar
-                  (lambda (x)
-                    (forward-line x)
-                    (rest-line-homogeneous-p))
-                  '(-1 2))))
-      (beginning-of-line)
-      (cond
-       ((equal ou '(nil nil)) nil)
-       ((car ou) 'over-and-under) ;; we only need check the overline
-       (t 'simple)
-       )
-      )))
 
-(defun rest-all-section-chars (&optional ignore-lines)
-  ;; FIXME this is insufficient
-  "Finds all the section characters in the entire file and orders
-  them hierarchically, removing duplicates.  Basically, returns a
-  list of the section underlining characters.
+(defun rest-suggest-new-decoration (alldecos)
+  "Suggest a new, different decoration, different from all that
+have been seen."
 
-  Optional parameters IGNORE-AROUND can be a list of lines to
-  ignore."
+  ;; For all the preferred decorations...
+  (let ((curpotential rest-preferred-decorations))
+    (while 
+	;; For all the decorations...
+	(let ((cur alldecos)
+	      found)
+	  (while (and cur (not found))
+	    (if (rest-compare-decorations (car cur) (car curpotential))
+		;; Found it!
+		(setq found (car curpotential))
+	      (setq cur (cdr cur))))
+	  found)
+      
+      (setq curpotential (cdr curpotential)))
 
-  (let (chars
-        c
-        (curline 1))
-    (save-excursion
-      (beginning-of-buffer)
-      (while (< (point) (buffer-end 1))
-        (if (not (memq curline ignore-lines))
-            (progn
-              (setq c (rest-line-homogeneous-p))
-              (if c
-                  (progn
-                    (add-to-list 'chars c t)
-                    ))) )
-        (forward-line 1) (setq curline (+ curline 1))
-        ))
-    chars))
+    (copy-list (car curpotential))))
 
 
-(defun rest-suggest-new-char (allchars)
-;; FIXME this is insufficient too
-  "Suggest a new, different character, different from all that
-have been seen."
-  (let ((potentials (copy-sequence rest-preferred-decorations)))
-    (dolist (x allchars)
-      (setq potentials (delq x potentials))
-      )
-    (car potentials)
-    ))
-
-
 (defun rest-update-section (char style &optional indent)
   "Unconditionally updates the style of a section decoration
   using the given character CHAR, with STYLE 'simple or
@@ -397,37 +271,214 @@
       ))
 
 
+(defun rest-normalize-cursor-position ()
+  "If the cursor is on a decoration line or an empty line , place
+  it on the section title line (at the end).  Returns the line
+  offset by which the cursor was moved. This works both over or
+  under a line."
+  (if (save-excursion (beginning-of-line)
+                      (or (rest-line-homogeneous-p 1)
+                          (looking-at "^[ \t]*$")))
+      (progn
+        (beginning-of-line)
+        (cond
+         ((save-excursion (forward-line -1)
+                          (beginning-of-line)
+                          (and (looking-at rest-section-text-regexp)
+                               (not (rest-line-homogeneous-p 1))))
+          (progn (forward-line -1) -1))
+         ((save-excursion (forward-line +1)
+                          (beginning-of-line)
+                          (and (looking-at rest-section-text-regexp)
+                               (not (rest-line-homogeneous-p 1))))
+          (progn (forward-line +1) +1))
+         (t 0)))
+    0 ))
 
 
+(defun rest-find-all-decorations ()
+  "Finds all the decorations in the file, and returns a list of
+  (line, decoration) pairs.  Each decoration consists in a (char,
+  style, indent) triple.
 
-;; FIXME: change these into defcustom
-(defvar rest-preferred-decorations
-  '( (?= over-and-under 1)
-     (?= simple 0)
-     (?- simple 0)
-     (?~ simple 0)
-     (?+ simple 0)
-     (?` simple 0)
-     (?# simple 0)
-     (?@ simple 0) )
-  "Preferred ordering of section title decorations.  This
-  sequence is consulted to offer a new decoration suggestion when
-  we rotate the underlines at the end of the existing hierarchy
-  of characters, or when there is no existing section title in
-  the file.")
+  This function does not detect the hierarchy of decorations, it
+  just finds all of them in a file.  You can then invoke another
+  function to remove redundancies and inconsistencies."
 
+  (let (positions
+        (curline 1))
+    ;; Iterate over all the section titles/decorations in the file.
+    (save-excursion
+      (beginning-of-buffer)
+      (while (< (point) (buffer-end 1))
+        (if (rest-line-homogeneous-p)
+            (progn
+              (setq curline (+ curline (rest-normalize-cursor-position)))
 
-;; FIXME: change these into defcustom
-(defvar rest-default-indent 1
-  "Number of characters to indent the section title when toggling
-  decoration styles.  This is used when switching from a simple
-  decoration style to a over-and-under decoration style.")
+              ;; Here we have found a potential site for a decoration,
+              ;; characterize it.
+              (let ((deco (rest-get-decoration)))
+                (if (cadr deco) ;; Style is existing.
+                    ;; Found a real decoration site.
+                    (progn
+                      (push (cons curline deco) positions)
+                      ;; Push beyond the underline.
+                      (forward-line 1)
+                      (setq curline (+ curline 1))
+                      )))
+              ))
+        (forward-line 1)
+        (setq curline (+ curline 1))
+        ))
+    (reverse positions)))
 
 
-(defvar rest-section-text-regexp "^[ \t]*\\S-+"
-  "Regular expression for valid section title text.")
+(defun rest-infer-hierarchy (decorations)
+  "Build a hierarchy of decorations using the list of given decorations.
 
+  This function expects a list of (char, style, indent)
+  decoration specifications, in order that they appear in a file,
+  and will infer a hierarchy of section levels by removing
+  decorations that have already been seen in a forward traversal of the 
+  decorations, comparing just the character and style.
 
+  Similarly returns a list of (char, style, indent), where each
+  list element should be unique."
+
+  (let ((hierarchy-alist (list)))
+    (dolist (x decorations)
+      (let ((char (car x))
+            (style (cadr x))
+            (indent (caddr x)))
+        (if (not (assoc (cons char style) hierarchy-alist))
+            (progn
+              (setq hierarchy-alist 
+                    (append hierarchy-alist 
+                            (list (cons (cons char style) x))))
+              ))
+        ))
+    (mapcar 'cdr hierarchy-alist)
+    ))
+
+
+(defun rest-get-hierarchy (&optional alldecos ignore)
+  "Returns a list of decorations that represents the hierarchy of
+  section titles in the file.
+ 
+  If the line number in IGNORE is specified, the decoration found
+  on that line (if there is one) is not taken into account when
+  building the hierarchy."
+  (let ((all (or alldecos (rest-find-all-decorations))))
+    (setq all (assq-delete-all ignore all))
+    (rest-infer-hierarchy (mapcar 'cdr all))))
+
+
+(defun rest-get-decoration (&optional point)
+  "Looks around point and finds the characteristics of the
+  decoration that is found there.  We assume that the cursor is
+  already placed on the title line (and not on the overline or
+  underline).
+
+  This function returns a (char, style, indent) triple.  If the
+  characters of overline and underline are different, we return
+  the underline character.  The indent is always calculated.  A
+  decoration can be said to exist if the style is not nil.
+
+  A point can be specified to go to the given location before
+  extracting the decoration."
+
+  (let (char style indent)
+    (save-excursion
+      (if point (goto-char point))
+      (beginning-of-line)
+      (if (looking-at rest-section-text-regexp)
+          (let (ou)
+            (save-excursion
+              (setq ou (mapcar
+                        (lambda (x)
+                          (forward-line x)
+                          (rest-line-homogeneous-p))
+                        '(-1 2))))
+
+            (beginning-of-line)
+            (cond
+             ;; No decoration found, leave all return values nil.
+             ((equal ou '(nil nil)))
+
+             ;; Overline only, leave all return values nil.
+             ;;
+             ;; Note: we don't return the overline character, but it could perhaps
+             ;; in some cases be used to do something.
+             ((and (car ou) (eq (cadr ou) nil)))
+
+             ;; Underline only.
+             ((and (cadr ou) (eq (car ou) nil))
+              (setq char (cadr ou)
+                    style 'simple))
+
+             ;; Both overline and underline.
+             (t
+              (setq char (cadr ou)
+                    style 'over-and-under))
+             )
+            )
+        )
+      ;; Find indentation.
+      (setq indent (save-excursion (back-to-indentation) (current-column)))
+      )
+    ;; Return values.
+    (list char style indent)))
+
+
+(defun rest-get-decorations-around (&optional alldecos)
+  "Given the list of all decorations (with positions), 
+find the decorations before and after the given point.  
+A list of the previous and next decorations is returned."
+  (let* ((all (or alldecos (rest-find-all-decorations)))
+	 (curline (rest-current-line))
+	 prev next
+	 (cur all))
+
+    ;; Search for the decorations around the current line.
+    (while (and cur (< (caar cur) curline))
+      (setq prev cur
+	    cur (cdr cur)))
+    ;; 'cur' is the following decoration.
+
+    (if (and cur (caar cur))
+	(setq next (if (= curline (caar cur)) (cdr cur) cur)))
+
+    (mapcar 'cdar (list prev next))
+    ))
+
+
+(defun rest-decoration-complete-p (deco &optional point)
+  "Return true if the decoration DECO around POINT is complete."
+
+  ;; There is some sectioning
+  ;; already present, so check if the current sectioning is complete and
+  ;; correct.
+  (let* ((char (car deco))
+         (style (cadr deco))
+         (indent (caddr deco))
+         (endcol (save-excursion (end-of-line) (current-column)))
+         )
+    (if char
+        (let ((exps (concat "^" 
+                            (regexp-quote (make-string (+ endcol indent) char))
+                            "$")))
+          (and
+           (save-excursion (forward-line +1)
+                           (beginning-of-line)
+                           (looking-at exps))
+           (or (not (eq style 'over-and-under))
+               (save-excursion (forward-line -1)
+                               (beginning-of-line)
+                               (looking-at exps))))
+          ))
+    ))
+
+
 (defun rest-adjust-section-decoration ()
   "Adjust/rotate the section decoration for the section title around point.
 
@@ -598,12 +649,9 @@
 C-- so a negative argument can be easily specified with a flick
 of the right hand fingers and the binding is unused in text-mode.
 "
-;; FIXME: you need to re-implement the algorithm to match the new description
-;; above
-
   (interactive)
   
-  (let* (;; Check if we're on an underline around a section title, and move the
+  (let* ( ;; Check if we're on an underline around a section title, and move the
          ;; cursor to the title if this is the case.
          (moved (rest-normalize-cursor-position))
 
@@ -612,149 +660,130 @@
          (char (car curdeco))
          (style (cadr curdeco))
          (indent (caddr curdeco))
+
+	 ;; New values to be computed.
+	 char-new style-new indent-new
          )
 
     ;; We've moved the cursor... if we're not looking at some text, we have
     ;; nothing to do.
     (if (save-excursion (beginning-of-line) 
                         (looking-at rest-section-text-regexp))
-        (cond 
+	(progn
+	  (cond 
 
-         ;;---------------------------------------------------------------------
-         ;; Case 1: No Decoration
-         ((and (eq char nil) (eq style nil))
-          
-          (let* ((all (rest-find-all-decorations))
-                 (curline (rest-current-line))
-                 prev 
-                 (cur all))
-            
-            ;; Search for the decorations around the current line.
-            (while (and cur (< (caar cur) curline))
-              (setq prev cur
-                    cur (cdr cur)))
-            ;; 'cur' is the following decoration.
-            
-            ;; Choose between the next or prefix.
-            (if (not (and current-prefix-arg
-                          (< (prefix-numeric-value current-prefix-arg) 0)))
-                ;; Choose the preceding decoration.
-                (setq cur prev))
-            
-            (if cur
-                (setq cur (cdar cur))
-              ;; We could not find the preceding/following decoration,
-              ;; use the first of the defaults.
-              (setq cur (car rest-preferred-decorations)))
-            
-            ;; Invert the style if requested.
-            (if (and current-prefix-arg
-                     (not (< (prefix-numeric-value current-prefix-arg) 0)))
-                (setcar (cdr cur) (if (eq (cadr cur) 'simple) 
-                                      'over-and-under 'simple)) )
-            
-            (apply 'rest-update-section cur)
-            ))
+	   ;;---------------------------------------------------------------------
+	   ;; Case 1: No Decoration
+	   ((and (eq char nil) (eq style nil))
+
+	    (let* ((around (rest-get-decorations-around))
+		   (prev (car around))
+		   (next (cadr around))
+		   cur)
+	      
+	      ;; Choose between the next or prefix.
+	      (setq cur 
+		    (if (not (and current-prefix-arg
+				  (< (prefix-numeric-value current-prefix-arg) 0)))
+			;; Choose the preceding decoration.
+			prev
+		      next))
+	      
+	      (if (not cur)
+		  ;; We could not find the preceding/following decoration,
+		  ;; use the first of the defaults.
+		  (setq cur (copy-list (car rest-preferred-decorations))))
+	      
+	      ;; Invert the style if requested.
+	      (if (and current-prefix-arg
+		       (not (< (prefix-numeric-value current-prefix-arg) 0)))
+		  (setcar (cdr cur) (if (eq (cadr cur) 'simple) 
+					'over-and-under 'simple)) )
+	      
+	      (setq char-new (car cur)
+		    style-new (cadr cur)
+		    indent-new (caddr cur))
+	      ))
          
-         ;;---------------------------------------------------------------------
-         ;; Case 2: Incomplete Decoration
-         ((not (rest-decoration-complete-p curdeco))
+	   ;;---------------------------------------------------------------------
+	   ;; Case 2: Incomplete Decoration
+	   ((not (rest-decoration-complete-p curdeco))
 
-          (if (and current-prefix-arg
-                   (not (< (prefix-numeric-value current-prefix-arg) 0)))
-              (setq style (if (eq style 'simple) 'over-and-under 'simple)))
+	    (if (and current-prefix-arg
+		     (not (< (prefix-numeric-value current-prefix-arg) 0)))
+		(setq style (if (eq style 'simple) 'over-and-under 'simple)))
 
-            (rest-update-section char style indent))
+            (setq char-new char
+		  style-new style 
+		  indent-new indent))
 
-         ;;---------------------------------------------------------------------
-         ;; Case 3: Complete Existing Decoration
-         (t
-          (if (and current-prefix-arg
-                   (not (< (prefix-numeric-value current-prefix-arg) 0)))
+	   ;;---------------------------------------------------------------------
+	   ;; Case 3: Complete Existing Decoration
+	   (t
+	    (if (and current-prefix-arg
+		     (not (< (prefix-numeric-value current-prefix-arg) 0)))
 
-              ;; Simply switch the style of the current decoration.
-              (rest-update-section 
-               char 
-               (if (eq style 'simple) 'over-and-under 'simple)
-               rest-default-indent)
+		;; Simply switch the style of the current decoration.
+		(setq char-new char
+		      style-new (if (eq style 'simple) 'over-and-under 'simple)
+		      indent-new rest-default-indent)
 
-            ;; Else, we rotate, ignoring the decoration around the current
-            ;; line...
-            (let* ((hier (rest-get-hierarchy (rest-current-line)))
-                   (cur hier)
-                   (prev nil)
-                  (negarg 
-                   (and current-prefix-arg
-                        (< (prefix-numeric-value current-prefix-arg) 0)))
-                  )
+	      ;; Else, we rotate, ignoring the decoration around the current
+	      ;; line...
+	      (let* ((alldecos (rest-get-hierarchy nil (rest-current-line)))
 
-              ;; Search for our current decoration in the hierarchy
-              (while (and cur (not (equal (car cur) curdeco)))
-                (setq prev (car cur)
-                      cur (cdr cur)))
+		     ;; Build a new list of decorations for the rotation.
+		     (rotdecos
+		      (append alldecos
+			      (filter 'identity
+				      (list
+				       ;; Suggest a new decoration.
+;;FIXME use previous decoration to find better suggestion
 
-;; FIXME: you need to figure out and fix the following
+				       (rest-suggest-new-decoration alldecos)
 
-              (setq cur
-                    (if cur 
-                        ;; Get the next level down(up).  If nil, this will
-                        ;; fallback on suggestion.
-                        (if negarg (progn (prin1 "prev") prev)
-                          (progn (prin1 "next") (cadr cur)))
-                      ;; We hit the boundary, cycle around.  If nothing is
-                      ;; available, this will fallback on suggestion.
-                      (if negarg 
-                          (progn (prin1 "boundup")
-                                 (car (last hier)))
-                        (progn (prin1 "boundup") (car hier)))))
+				       ;; If nothing to suggest, use first
+				       ;; decoration.
+				       (car alldecos)))))
 
-              (prin1 cur)
+		     (negarg 
+		      (and current-prefix-arg
+			   (< (prefix-numeric-value current-prefix-arg) 0)))
+		   
+		     (nextdeco (or
+				;; Search for next decoration.
+				(cadr 
+				 (let ((cur (if negarg (reverse rotdecos) rotdecos))
+				       found)
+				   (while (and cur
+					       (not (and (eq char (caar cur))
+							 (eq style (cadar cur)))))
+				     (setq cur (cdr cur)))
+				   cur))
+			      
+				;; If not found, take the first of all decorations.
+;;FIXME use previous decoration to find better suggestion
+				(rest-suggest-new-decoration alldecos)
+				))
+		     )
 
-              ;; Find one of the preferred decorations to suggest, the first
-              ;; that has not been seen in the file.
-              (if cur
-                  (apply 'rest-update-section cur)
-                (prin1 "notfound"))
+		;; Indent, if present, always overrides the prescribed indent.
+		(setq char-new (car nextdeco)
+		      style-new (cadr nextdeco)
+		      indent-new (caddr nextdeco))
 
+		)))
+	   )
+		 
+	  ;; Override indent with present indent!
+	  (setq indent-new (if (> indent 0) indent indent-new))
 
+	  ;;;(print (list char-new style-new indent-new))
+	  (if (and char-new style-new)
+	      (rest-update-section char-new style-new indent-new))
+	  ))
 
-              )))
 
-;; FIXME: this should work:
-;;
-;; sidsdsdsd
-;; ---------
-
-
-;; If the decoration is complete (i.e. the underline (overline)
-;; length is already adjusted to the end of the title line), we
-;; search/parse the file to establish the hierarchy of all the
-;; decorations (making sure not to include the decoration around
-;; point), and we rotate the current title's decoration from within
-;; that list (by default, going *down* the hierarchy that is present
-;; in the file, i.e. to a lower section level).  This is meant to be
-;; used potentially multiple times, until the desired decoration is
-;; found around the title.
-
-;; If we hit the boundary of the hierarchy, exactly one choice from
-;; the list of preferred decorations is suggested/chosen, the first
-;; of those decoration that has not been seen in the file yet (and
-;; not including the decoration around point), and the next
-;; invocation rolls over to the other end of the hierarchy (i.e. it
-;; cycles).  This allows you to avoid having to set which character
-;; to use by always using the
-
-;; If a negative argument is specified, the effect is to change the
-;; direction of rotation in the hierarchy of decorations, thus
-;; instead going *up* the hierarchy.
-
-;; However, if there is a non-negative prefix argument, we do not
-;; rotate the decoration, but instead simply toggle the style of the
-;; current decoration (this should be the most common way to toggle
-;; the style of an existing complete decoration).
-
-         ))
-
     ;; Correct the position of the cursor to more accurately reflect where it
     ;; was located when the function was invoked.
     (if (not (= moved 0))
@@ -767,167 +796,6 @@
 (defalias 'rest-adjust-section-title 'rest-adjust-section-decoration)
 
 
-(defun rest-normalize-cursor-position ()
-  "If the cursor is on a decoration line or an empty line , place
-  it on the section title line (at the end).  Returns the line
-  offset by which the cursor was moved. This works both over or
-  under a line."
-  (if (save-excursion (beginning-of-line)
-                      (or (rest-line-homogeneous-p 1)
-                          (looking-at "^[ \t]*$")))
-      (progn
-        (beginning-of-line)
-        (cond
-         ((save-excursion (forward-line -1)
-                          (beginning-of-line)
-                          (and (looking-at rest-section-text-regexp)
-                               (not (rest-line-homogeneous-p 1))))
-          (progn (forward-line -1) -1))
-         ((save-excursion (forward-line +1)
-                          (beginning-of-line)
-                          (and (looking-at rest-section-text-regexp)
-                               (not (rest-line-homogeneous-p 1))))
-          (progn (forward-line +1) +1))
-         (t 0)))
-    0 ))
-
-
-(defun rest-find-all-decorations ()
-  "Finds all the decorations in the file, and returns a list of
-  (line, decoration) pairs.  Each decoration consists in a (char,
-  style, indent) triple.
-
-  This function does not detect the hierarchy of decorations, it
-  just finds all of them in a file.  You can then invoke another
-  function to remove redundancies and inconsistencies."
-
-  (let (positions
-        (curline 1))
-    ;; Iterate over all the section titles/decorations in the file.
-    (save-excursion
-      (beginning-of-buffer)
-      (while (< (point) (buffer-end 1))
-        (if (rest-line-homogeneous-p)
-            (progn
-              (setq curline (+ curline (rest-normalize-cursor-position)))
-
-              ;; Here we have found a potential site for a decoration,
-              ;; characterize it.
-              (let ((deco (rest-get-decoration)))
-                (if (cadr deco) ;; Style is existing.
-                    ;; Found a real decoration site.
-                    (progn
-                      (push (cons curline deco) positions)
-                      ;; Push beyond the underline.
-                      (forward-line 1)
-                      (setq curline (+ curline 1))
-                      )))
-              ))
-        (forward-line 1)
-        (setq curline (+ curline 1))
-        ))
-    (reverse positions)))
-
-
-(defun rest-get-hierarchy (&optional ignore)
-  "Returns a list of decorations that represents the hierarchy of
-  section titles in the file.
- 
-  If the line number in IGNORE is specified, the decoration found
-  on that line (if there is one) is not taken into account when
-  building the hierarchy."
-  (let ((all (rest-find-all-decorations)))
-    (setq all (assq-delete-all ignore all))
-    (rest-infer-hierarchy (mapcar 'cdr all))))
-
-
-(defun rest-infer-hierarchy (decorations)
-  "Build a hierarchy of decorations using the list of given decorations.
-
-  This function expects a list of (char, style, indent)
-  decoration specifications, in order that they appear in a file,
-  and will infer a hierarchy of section levels by removing
-  decorations that have already been seen in a forward traversal of the 
-  decorations, comparing just the character and style.
-
-  Similarly returns a list of (char, style, indent), where each
-  list element should be unique."
-
-  (let ((hierarchy-alist (list)))
-    (dolist (x decorations)
-      (let ((char (car x))
-            (style (cadr x))
-            (indent (caddr x)))
-        (if (not (assoc (cons char style) hierarchy-alist))
-            (progn
-              (setq hierarchy-alist 
-                    (append hierarchy-alist 
-                            (list (cons (cons char style) x))))
-              ))
-        ))
-    (mapcar 'cdr hierarchy-alist)
-    ))
-
-
-(defun rest-get-decoration (&optional point)
-  "Looks around point and finds the characteristics of the
-  decoration that is found there.  We assume that the cursor is
-  already placed on the title line (and not on the overline or
-  underline).
-
-  This function returns a (char, style, indent) triple.  If the
-  characters of overline and underline are different, we return
-  the underline character.  The indent is always calculated.  A
-  decoration can be said to exist if the style is not nil.
-
-  A point can be specified to go to the given location before
-  extracting the decoration."
-
-  (let (char style indent)
-    (save-excursion
-      (if point (goto-char point))
-      (beginning-of-line)
-      (if (looking-at rest-section-text-regexp)
-          (let (ou)
-            (save-excursion
-              (setq ou (mapcar
-                        (lambda (x)
-                          (forward-line x)
-                          (rest-line-homogeneous-p))
-                        '(-1 2))))
-
-            (beginning-of-line)
-            (cond
-             ;; No decoration found, leave all return values nil.
-             ((equal ou '(nil nil)))
-
-             ;; Overline only, leave all return values nil.
-             ;;
-             ;; Note: we don't return the overline character, but it could perhaps
-             ;; in some cases be used to do something.
-             ((and (car ou) (eq (cadr ou) nil)))
-
-             ;; Underline only.
-             ((and (cadr ou) (eq (car ou) nil))
-              (setq char (cadr ou)
-                    style 'simple))
-
-             ;; Both overline and underline.
-             (t
-              (setq char (cadr ou)
-                    style 'over-and-under))
-             )
-            )
-        )
-      ;; Find indentation.
-      (setq indent (save-excursion
-                     (back-to-indentation)
-                     (current-column)))
-      )
-    ;; Return values.
-    (list char style indent)))
-
-
 (defun rest-display-sections-hierarchy (&optional decorations)
   "Display the current file's section title decorations hierarchy.
   This function expects a list of (char, style, indent) triples."
@@ -948,76 +816,9 @@
     )))
 
 
-(defun rest-decoration-complete-p (deco &optional point)
-  "Return true if the decoration DECO around POINT is complete."
 
-  ;; There is some sectioning
-  ;; already present, so check if the current sectioning is complete and
-  ;; correct.
-  (let* ((char (car deco))
-         (style (cadr deco))
-         (indent (caddr deco))
-         (endcol (save-excursion (end-of-line) (current-column)))
-         )
-    (if char
-        (let ((exps (concat "^" 
-                            (regexp-quote (make-string (+ endcol indent) char))
-                            "$")))
-          (and
-           (save-excursion (forward-line +1)
-                           (beginning-of-line)
-                           (looking-at exps))
-           (or (not (eq style 'over-and-under))
-               (save-excursion (forward-line -1)
-                               (beginning-of-line)
-                               (looking-at exps))))
-          ))
-    ))
 
 
-;;(setq debug-on-error t)
-
-;; (global-set-key 
-;;  [(control x) (control ?=)]
-;;  (lambda () (interactive)
-;;    (message (prin1-to-string
-;;              (progn 
-;;              (rest-get-decoration)
-;;              )))))
-
-
-(global-set-key [(control ?=)] 'rest-adjust-section-decoration)
-(global-set-key [(control x) (control ?=)] 'rest-display-sections-hierarchy)
-
-
-
-
-
-
-
-
-
-;; FIXME: we need a function to display the hierarchical levels in the file
-
-;; FIXME: we should separate the underlining behaviour from the rest
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; Section movement commands.
@@ -1026,7 +827,6 @@
 ;; FIXME: these should be using the new decoration detection functions
 
 
-
 ;; Note: this is not quite correct, the definition is any non alpha-numeric
 ;; character.
 (defun rest-title-char-p (c)
@@ -1082,11 +882,100 @@
 
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Generic text functions that are more convenient than the defaults.
+;;
 
+(defun replace-lines (fromchar tochar)
+  "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 join-paragraph ()
+  "Join lines in current paragraph into one line, removing end-of-lines."
+  (interactive)
+  (let ((fill-column 65000)) ; some big number
+    (call-interactively 'fill-paragraph)))
 
+(defun force-fill-paragraph ()
+  "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))
 
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Generic character repeater function.
+;;
+;; For sections, better to use the specialized function above, but this can
+;; be useful for creating separators.
+
+(defun 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.
+
+If a prefix argument is provided, use the next line rather than the preceding
+line.
+
+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
+column is used (fill-column vs. end of previous/next line)."
+  (interactive)
+  (let* ((curcol (current-column))
+         (curline (+ (count-lines (point-min) (point))
+                     (if (eq curcol 0) 1 0)))
+         (lbp (line-beginning-position 0))
+         (prevcol (if (and (= curline 1) (not current-prefix-arg))
+                      fill-column
+                    (save-excursion
+                      (forward-line (if current-prefix-arg 1 -1))
+                      (end-of-line)
+                      (skip-chars-backward " \t" lbp)
+                      (let ((cc (current-column)))
+                        (if (= cc 0) fill-column cc)))))
+         (rightmost-column
+          (cond (tofill 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))))
+    ))
+
+
 (provide 'restructuredtext)
 

Modified: branches/better-emacs/emacs/tests/tests-adjust-section.el
===================================================================
--- branches/better-emacs/emacs/tests/tests-adjust-section.el	2005-09-06 14:55:48 UTC (rev 3854)
+++ branches/better-emacs/emacs/tests/tests-adjust-section.el	2005-09-07 18:59:48 UTC (rev 3855)
@@ -61,8 +61,9 @@
 
 "
 "
-Some Title
-==========
+============
+ Some Title
+============
 
 ")
 
@@ -122,7 +123,7 @@
 )
 
 ;;------------------------------------------------------------------------------
-(nodec-first-forced
+(nodec-first-forced-2
 "
    Some Title@
 
@@ -170,7 +171,7 @@
 --------------
 
 Some Title
-~~~~~~~~~~
+----------
 
 Next Title
 ~~~~~~~~~~
@@ -191,9 +192,9 @@
 Previous Title
 --------------
 
-------------
- Some Title
-------------
+----------
+Some Title
+----------
 
 "
 (t))
@@ -211,8 +212,9 @@
 Previous Title
 --------------
 
-Some Title
-----------
+--------------
+  Some Title
+--------------
 
 "
 (t))
@@ -231,9 +233,8 @@
 Previous Title
 --------------
 
----------------
-   Some Title
----------------
+Some Title
+----------
 
 "
 )
@@ -270,6 +271,7 @@
 "
 Previous Title
 --------------
+
 "
 )
 
@@ -282,6 +284,7 @@
 "
 Previous Title
 --------------
+
 "
 )
 
@@ -292,8 +295,10 @@
 -@
 "
 "
-Previous Title
---------------
+================
+ Previous Title
+================
+
 "
 )
 
@@ -306,6 +311,7 @@
 "
 Previous Title
 --------------
+
 "
 )
 
@@ -320,6 +326,7 @@
 ----------------
  Previous Title
 ----------------
+
 "
 )
 
@@ -334,6 +341,7 @@
 ----------------
  Previous Title
 ----------------
+
 "
 )
 
@@ -348,6 +356,7 @@
 ----------------
  Previous Title
 ----------------
+
 "
 )
 
@@ -358,9 +367,10 @@
 ----------@
 "
 "
-----------------
- Previous Title
-----------------
+--------------
+Previous Title
+--------------
+
 "
 (t))
 
@@ -374,6 +384,7 @@
 "
 Previous Title
 --------------
+
 "
 (t))
 
@@ -387,6 +398,7 @@
 "
 Previous Title
 --------------
+
 "
 (t))
 
@@ -507,7 +519,7 @@
 ================
 
 SubTitle
---------
+========
 
 ==========
  My Title
@@ -527,7 +539,7 @@
 ========
 
 ==========
- My Title
+ My Title@
 ==========
 
 "
@@ -546,7 +558,7 @@
 (-1))
 
 ;;------------------------------------------------------------------------------
-(complete-simple-boundary-up
+(complete-simple-boundary-up ;; Note: boundary-up does not exist.
 "
 ================
  Document Title
@@ -566,9 +578,8 @@
 SubTitle
 ========
 
-==========
- My Title
-==========
+My Title
+========
 
 "
 (-1))
@@ -629,6 +640,7 @@
 ================
  Document Title@
 ================
+
 "
 )
 
@@ -641,7 +653,8 @@
 
 ================
  Document Title@
-================"
+================
+"
 )
 
 ;;
@@ -812,5 +825,5 @@
    rest-adjust-section-tests
    (lambda ()
      (call-interactively 'rest-adjust-section-title))
-   t))
+   nil))
 

Modified: branches/better-emacs/emacs/tests/tests-basic.el
===================================================================
--- branches/better-emacs/emacs/tests/tests-basic.el	2005-09-06 14:55:48 UTC (rev 3854)
+++ branches/better-emacs/emacs/tests/tests-basic.el	2005-09-07 18:59:48 UTC (rev 3855)
@@ -82,7 +82,6 @@
 
 @Du bon vin tous les jours.
 -----------
-
 "
 )
 
@@ -401,6 +400,21 @@
 
 ")
 
+
+(setq text-2
+"
+
+Previous
+--------
+
+Current@
+~~~~~~~
+
+Next
+++++
+
+")
+
 ;; ~~~~~~~~~~~~~~~~~~
 ;;  Buggy Decoration
 ;; ~~~~~~
@@ -423,6 +437,13 @@
 		  (26 126 over-and-under 1)
 		  (31 61 simple 0))
 		 )
+
+	(basic-2 ,text-2
+		 ((3 45 simple 0)
+		  (6 126 simple 0)
+		  (9 43 simple 0))
+		 )
+
 	))
 
 
@@ -467,7 +488,7 @@
   (regression-test-compare-expect-values
    "Test finding the hierarchy of sections in a file, ignoring lines."
    rest-get-hierarchy-ignore-tests
-   (lambda () (rest-get-hierarchy (rest-current-line))) nil))
+   (lambda () (rest-get-hierarchy nil (rest-current-line))) nil))
 
 
 
@@ -618,7 +639,7 @@
 " nil ((?= over-and-under 0)))
 
 ;;------------------------------------------------------------------------------
-(incomplete-mixed
+(incomplete-mixed-2
 "
 ==========
   @Vaudou
@@ -644,73 +665,42 @@
 
 
 
+(setq rest-get-decorations-around-tests
+  '(
+;;------------------------------------------------------------------------------
+(simple
+"
 
+Previous
+--------
 
+@Current
 
+Next
+++++
 
+" ((?- simple 0) (?+ simple 0)))
 
+;;------------------------------------------------------------------------------
+(simple-2
+"
 
+Previous
+--------
 
-; (setq rest-find-last-section-char-tests
-;   '(
-; ;;------------------------------------------------------------------------------
-; (simple "
-; Simple Title
-; ------------
-; @
-; " ?-)
-; ;;------------------------------------------------------------------------------
-; (simple2 "
-; Simple Title1
-; =============
-; 
-; Simple Title
-; ------------
-; @
-; " ?-)
-; ))
-; 
-; (progn
-;   (regression-test-compare-expect-values
-;    "Tests finding the last decoration."
-;    rest-find-last-section-char-tests
-;    'rest-find-last-section-char)
-;    nil)
-; 
-; 
-; 
-; 
-; (setq rest-current-section-char-tests
-;   '(
-; ;;------------------------------------------------------------------------------
-; (simple "
-; Simple Title
-; ------------
-; @
-; " ?-)
-; ;;------------------------------------------------------------------------------
-; (incomplete "
-; Simple Title
-; ---------
-; @
-; " ?-)
-; ;;------------------------------------------------------------------------------
-; (over-and-under "
-; ================
-;   Simple Title
-; ================
-; @
-; " ?=)
-; ))
-; 
-; (progn
-;   (regression-test-compare-expect-values
-;    "Tests finding the current decoration."
-;    rest-current-section-char-tests
-;    (lambda () (rest-current-section-char (point)))
-;    t))
-; 
-; 
+Current@
+~~~~~~~
 
-;;; FIXME continue here, write more tests.
+Next
+++++
 
+" ((?- simple 0) (?+ simple 0)))
+
+))
+
+(progn
+  (regression-test-compare-expect-values
+   "Tests getting the decorations around a point."
+   rest-get-decorations-around-tests 'rest-get-decorations-around nil))
+
+

Modified: branches/better-emacs/emacs/tests/tests-runner.el
===================================================================
--- branches/better-emacs/emacs/tests/tests-runner.el	2005-09-06 14:55:48 UTC (rev 3854)
+++ branches/better-emacs/emacs/tests/tests-runner.el	2005-09-07 18:59:48 UTC (rev 3855)
@@ -65,20 +65,31 @@
       (funcall fun)))
 
   ;; Compare the buffer output with the expected text.
-  (let (;; Get the actual buffer contents.
-	(actual (buffer-string))
-	;; Get the expected location of point
-	(exppoint 
-	 (+ (string-match regression-point-char expected) 1))
-	)
-    (if (not (string= expected actual))
+  (let* (;; Get the actual buffer contents.
+	 (actual (buffer-string))
+	 ;; Get the expected location of point
+	 (exppoint (string-match regression-point-char expected))
+	 
+	 (expected-clean (if exppoint
+			     (concat (substring expected 0 exppoint)
+				     (substring expected (+ 1 exppoint)))
+			   expected))
+
+	 ;; Adjust position of point vs. string index.
+	 (exppoint (and exppoint (+ exppoint 1)))
+
+	 )
+
+    (if (not (string= expected-clean actual))
 	;; Error! Test failed.
-	(format "Error: Test %s failed: expected\n%sgot\n%s"
-		testname expected actual))
-    (if (and exppoint (not (equal exppoint (point))))
-	;; Error! Test failed, final position of cursor is not the same.
-	(format "Error: Test %s failed: cursor badly placed." testname))
-    ))
+	(format "Error: Test %s failed: \nexpected\n%s\ngot\n%s"
+		testname 
+		(prin1-to-string expected-clean) 
+		(prin1-to-string actual))
+      (if (and exppoint (not (equal exppoint (point))))
+	  ;; Error! Test failed, final position of cursor is not the same.
+	  (format "Error: Test %s failed: cursor badly placed." testname))
+    )))
 
 (defun regression-test-compare-expect-buffer 
   (suitename testlist fun &optional continue)