ewoc patch

ewoc patch

[Tom Breton (Tehom)]

[-- Attachment #1: Type: text/plain, Size: 1777 bytes --]

I like the ewoc package, but I found it somewhat inflexible.  I am
submitting this diff (attached) in the hope of improving it.

In particular:

 * ewoc always wants every entry to be separated from the other
   entries by a newline.

 * It does not work properly with blank entries.  These become a real
   problem when a blank separator is allowed.  Nodes often get printed
   out of order.

 * ewoc-map is slightly misnamed; it doesn't map, it's more like
   for-each.

Summary of changes:

 * Added a version number.  I didn't have much to go on, so I just
   said it was "2.0".  I will gladly change it to correspond to an
   official version number.

 * ewoc-create takes an optional fourth argument, "separator"

 * Added a new field to the ewoc, "separator".  That's the string that
   separates entries.  It defaults to "\n".

 * Added functions

   * ewoc--raw-location

   * ewoc--next-printed-node

   * ewoc--next-start-marker

   * ewoc-location-safe

   * ewoc--print-node

   * ewoc--print-anew

   * ewoc--delete-node-text

   * ewoc--mark-node-empty

 * Added alias: ewoc-foreach for ewoc-map

 * Removed ewoc--create-node.

 * Rearranged some functionality:

   * All printing goes thru new function ewoc--print-node

   * All unprinting uses new function ewoc--mark-node-empty.

 * Design: Nodes that have no text have no start marker.

 * Design: ewoc now handles the different printing of header/footer vs
   other nodes by passing a printer function to `ewoc--print-node'.

Testing:

 * Created a test suite.  The suite relies on rtest, which
   unfortunately is still between releasable versions.

 * Thru application "colorcomp" (written by TTN, thank you)

        Tom Breton (Tehom)

[-- Attachment #2: ewoc.el.3.diff --]
[-- Type: application/octet-stream, Size: 20336 bytes --]

cd /home/tehom/projects/emtest/lisp/viewers/
diff -c -b /home/tehom/emacs-21.4/lisp/emacs-lisp/ewoc.el /home/tehom/projects/emtest/lisp/viewers/ewoc.el
*** /home/tehom/emacs-21.4/lisp/emacs-lisp/ewoc.el	2001-07-16 08:22:59.000000000 -0400
--- /home/tehom/projects/emtest/lisp/viewers/ewoc.el	2009-12-08 22:57:46.000000000 -0500
***************
*** 129,134 ****
--- 129,136 ----
  
  (eval-when-compile (require 'cl))	;because of CL compiler macros
  
+ (defconst ewoc-version "2.0")
+ 
  ;; The doubly linked list is implemented as a circular list
  ;; with a dummy node first and last. The dummy node is used as
  ;; "the dll" (or rather is the dll handle passed around).
***************
*** 197,215 ****
        (setq n (1- n)))
      (unless (eq dll node) node)))
  
- (defun ewoc-location (node)
-   "Return the start location of NODE."
-   (ewoc--node-start-marker node))
- 
  \f
  ;;; The ewoc data type
  
  (defstruct (ewoc
  	    (:constructor nil)
  	    (:constructor ewoc--create
! 			  (buffer pretty-printer header footer dll))
  	    (:conc-name ewoc--))
!   buffer pretty-printer header footer dll last-node)
  
  (defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
    "Execute FORMS with ewoc--buffer selected as current buffer,
--- 199,216 ----
        (setq n (1- n)))
      (unless (eq dll node) node)))
  
  \f
  ;;; The ewoc data type
  
  (defstruct (ewoc
  	    (:constructor nil)
  	    (:constructor ewoc--create
! 			  (buffer pretty-printer header footer dll
! 			     separator))
  	    (:conc-name ewoc--))
!   buffer pretty-printer header footer dll last-node separator)
! 
! 
  
  (defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
    "Execute FORMS with ewoc--buffer selected as current buffer,
***************
*** 238,329 ****
  	      (eq node (ewoc--footer ewoc)))
      node))
  
- 
- (defun ewoc--create-node (data pretty-printer pos)
-   "Call PRETTY-PRINTER with point set at POS in current buffer.
- Remember the start position. Create a wrapper containing that
- start position and the element DATA."
-   (save-excursion
-     ;; Remember the position as a number so that it doesn't move
-     ;; when we insert the string.
-     (when (markerp pos) (setq pos (marker-position pos)))
-     (goto-char pos)
-     (let ((inhibit-read-only t))
-       ;; Insert the trailing newline using insert-before-markers
-       ;; so that the start position for the next element is updated.
-       (insert-before-markers ?\n)
-       ;; Move back, and call the pretty-printer.
-       (backward-char 1)
-       (funcall pretty-printer data)
-       (ewoc--node-create (copy-marker pos) data))))
- 
- 
  (defun ewoc--delete-node-internal (ewoc node)
    "Delete a data string from EWOC.
  Can not be used on the footer. Returns the wrapper that is deleted.
  The start-marker in the wrapper is set to nil, so that it doesn't
  consume any more resources."
    (let ((dll (ewoc--dll ewoc))
  	(inhibit-read-only t))
!     ;; If we are about to delete the node pointed at by last-node,
!     ;; set last-node to nil.
      (if (eq (ewoc--last-node ewoc) node)
  	(setf (ewoc--last-node ewoc) nil))
! 
!     (delete-region (ewoc--node-start-marker node)
! 		   (ewoc--node-start-marker (ewoc--node-next dll node)))
!     (set-marker (ewoc--node-start-marker node) nil)
!     ;; Delete the node, and return the wrapper.
!     (ewoc--node-delete node)))
! 
  
  (defun ewoc--refresh-node (pp node)
    "Redisplay the element represented by NODE using the pretty-printer PP."
    (let ((inhibit-read-only t))
      (save-excursion
!       ;; First, remove the string from the buffer:
!       (delete-region (ewoc--node-start-marker node)
! 		     (1- (marker-position
! 			  (ewoc--node-start-marker (ewoc--node-right node)))))
!       ;; Calculate and insert the string.
!       (goto-char (ewoc--node-start-marker node))
!       (funcall pp (ewoc--node-data node)))))
  \f
  ;;; ===========================================================================
  ;;;                  Public members of the Ewoc package
  
  
! (defun ewoc-create (pretty-printer &optional header footer)
    "Create an empty ewoc.
  
  The ewoc will be inserted in the current buffer at the current position.
  
  PRETTY-PRINTER should be a function that takes one argument, an
  element, and inserts a string representing it in the buffer (at
! point). The string PRETTY-PRINTER inserts may be empty or span
! several linse. A trailing newline will always be inserted
! automatically. The PRETTY-PRINTER should use insert, and not
! insert-before-markers.
  
! Optional third argument HEADER is a string that will always be
  present at the top of the ewoc. HEADER should end with a
! newline.  Optionaly fourth argument FOOTER is similar, and will
! be inserted at the bottom of the ewoc."
!   (let ((new-ewoc
! 	 (ewoc--create (current-buffer)
! 		       pretty-printer nil nil (ewoc--dll-create)))
  	(pos (point)))
      (ewoc--set-buffer-bind-dll new-ewoc
        ;; Set default values
        (unless header (setq header ""))
        (unless footer (setq footer ""))
        (setf (ewoc--node-start-marker dll) (copy-marker pos))
!       (let ((foot (ewoc--create-node footer (lambda (x) (insert footer)) pos))
! 	    (head (ewoc--create-node header (lambda (x) (insert header)) pos)))
! 	(ewoc--node-enter-first dll head)
! 	(ewoc--node-enter-last  dll foot)
  	(setf (ewoc--header new-ewoc) head)
  	(setf (ewoc--footer new-ewoc) foot)))
      ;; Return the ewoc
      new-ewoc))
  
--- 239,430 ----
  	      (eq node (ewoc--footer ewoc)))
      node))
  
  (defun ewoc--delete-node-internal (ewoc node)
     "Delete a data string from EWOC.
  Can not be used on the footer. Returns the wrapper that is deleted.
  The start-marker in the wrapper is set to nil, so that it doesn't
  consume any more resources."
+    (when (ewoc--node-start-marker node)
        (let ((dll (ewoc--dll ewoc))
  	      (inhibit-read-only t))
! 	 ;; If we are about to delete the node pointed at by
! 	 ;; last-node, set last-node to nil.
  	 (if (eq (ewoc--last-node ewoc) node)
  	    (setf (ewoc--last-node ewoc) nil))
! 	 (ewoc--delete-node-text node)
! 	 ;; Delete the node from the dll and return the wrapper.
! 	 (ewoc--node-delete node))))
  
  (defun ewoc--refresh-node (pp node)
        "Redisplay the element represented by NODE using the pretty-printer PP."
+       (assert node)
        (let ((inhibit-read-only t))
  	 (save-excursion
! 	    (goto-char (ewoc-location-safe node))
! 	    (ewoc--delete-node-text node)
! 	    (ewoc--print-anew node pp))))
! 
! \f
! ;;; ===========================================================================
! ;;;                  Node location
! 
! (defun ewoc--raw-location (node)
!       "Return the start location of NODE.
! If NODE is empty, return nil."
!       (ewoc--node-start-marker node))
! 
! (defun ewoc--next-printed-node (node)
!    "Return the next non-empty node after NODE."
!    ;;This loop will terminate because we set at least one
!    ;;start-marker in the ewoc when creating it.
!    (do
!       ((node-after 
! 	  (ewoc--node-right node) 
! 	  (ewoc--node-right node-after)))
!       (
! 	 (ewoc--node-start-marker node-after)
! 	 node-after)))
!    
! (defun ewoc--next-start-marker (node)
!    "Return the first start marker after NODE."
!    (ewoc--node-start-marker
!       (ewoc--next-printed-node node)))
! 
! (defun ewoc-location (node)
!    "Return the start location of NODE.
! If NODE is empty, return the start marker of the next non-empty node."
!    (or
!       (ewoc--raw-location node)
!       (ewoc--next-start-marker node)))
! 
! ;;A start-marker's insertion-type should already be `t', but some
! ;;callers want to be 100% sure it is, so this function exists.
! (defun ewoc-location-safe (node)
!    "Get NODE's start location.  
! Also set the start-marker's insertion type to `t' so that it will stay
! after any text inserted at that point."
! 
!    (let
!       ((next-start-marker (ewoc-location node)))
!       (set-marker-insertion-type next-start-marker t)
!       next-start-marker))
! 
! \f
! ;;; ===========================================================================
! ;;;                  Printing and unprinting
! 
! (defun ewoc--mark-node-empty (node)
!    "Mark NODE empty (but don't empty it, assume it was emptied)
! INTERNAL USE ONLY."
!    (let
!       ((start-marker (ewoc--node-start-marker node)))
!       (when start-marker
! 	 (set-marker start-marker nil)
! 	 (setf
! 	    (ewoc--node-start-marker node)
! 	    nil))))
! 
! (defun ewoc--delete-node-text (node)
!    "Delete a node's text."
!    (when
!       (ewoc--node-start-marker node)
!       (delete-region
! 	 (ewoc--node-start-marker node)
! 	 (ewoc--next-start-marker node))
!       (ewoc--mark-node-empty node)))
! 
! (defun ewoc--print-anew (node pp)
!    "Print a node that was erased."
!    (ewoc--mark-node-empty node)
!    (ewoc--print-node node pp))
! 
!    
! (defun ewoc--print-node (node printer)
!    "Print NODE at point using PRINTER.
! Set NODE's start-marker accordingly."
!    ;;Only print if node is currently empty
!    (when (ewoc--node-start-marker node)
!       (error "ewoc--print-node called with a node that's already printed"))
! 
!    (let
!       (
! 	 (start-pos (point))
! 	 (inhibit-read-only t))
! 
!       (funcall printer (ewoc-data node))
!       (let
! 	 ((separator (ewoc--separator ewoc)))
! 	 (when separator (insert separator)))
! 
!       ;;Only set up this node as non-empty if it actually is
!       ;;non-empty.
!       (unless
! 	 (= start-pos (point))
! 	 ;;Set its start-marker to the position we started
! 	 ;;printing from.
! 	 (setf 
! 	    (ewoc--node-start-marker node)
! 	    (copy-marker start-pos t)))))
! 
  \f
  ;;; ===========================================================================
  ;;;                  Public members of the Ewoc package
  
  
! (defun ewoc-create (pretty-printer &optional header footer separator)
!    
    "Create an empty ewoc.
  
  The ewoc will be inserted in the current buffer at the current position.
  
  PRETTY-PRINTER should be a function that takes one argument, an
  element, and inserts a string representing it in the buffer (at
! point). The string PRETTY-PRINTER inserts may be empty or span several
! linse. SEPARATOR will be inserted automatically. The PRETTY-PRINTER
! should use insert, and not insert-before-markers.
  
! Optional second argument HEADER is a string that will always be
  present at the top of the ewoc. HEADER should end with a
! newline.  Optional third argument FOOTER is similar, and will
! be inserted at the bottom of the ewoc.
! 
! Optional fourth argument SEPARATOR is a string.  It will be inserted
! after each entry and after header and footer.  It defaults to one
! newline."
! 
!   (let* (
! 	   (separator
! 	      (cond
! 		 ((null separator) "\n")
! 		 ((stringp separator)
! 		    (if (string= separator "") nil separator))
! 		 (t (error "ewoc-create: separator %s is not a string"
! 		       separator))))
! 	   (new-ewoc
! 	      (ewoc--create 
! 		 (current-buffer)
! 		 pretty-printer
! 		 nil nil (ewoc--dll-create)
! 		 separator))
  	   (pos (point)))
       (ewoc--set-buffer-bind-dll new-ewoc
  	;; Set default values
  	(unless header (setq header ""))
  	(unless footer (setq footer ""))
  	(setf (ewoc--node-start-marker dll) (copy-marker pos))
! 
! 	(let*
! 	   ((foot 
! 	       (ewoc-enter-before
! 		  new-ewoc dll footer #'insert))
! 	      
! 	      (head 
! 		 (ewoc-enter-before
! 		    new-ewoc foot header #'insert)))
! 	   
  	   (setf (ewoc--header new-ewoc) head)
  	   (setf (ewoc--footer new-ewoc) foot)))
+      
       ;; Return the ewoc
       new-ewoc))
  
***************
*** 346,361 ****
    (ewoc--set-buffer-bind-dll ewoc
      (ewoc-enter-before ewoc (ewoc--node-next dll node) data)))
  
! (defun ewoc-enter-before (ewoc node data)
!   "Enter a new element DATA before NODE in EWOC.
  Returns the new NODE."
    (ewoc--set-buffer-bind-dll ewoc
!     (ewoc--node-enter-before
!      node
!      (ewoc--create-node
!       data
!       (ewoc--pretty-printer ewoc)
!       (ewoc--node-start-marker node)))))
  
  (defun ewoc-next (ewoc node)
    "Get the next node.
--- 447,469 ----
    (ewoc--set-buffer-bind-dll ewoc
      (ewoc-enter-before ewoc (ewoc--node-next dll node) data)))
  
! (defun ewoc-enter-before (ewoc node data &optional printer)
!    "Create a new element DATA before NODE in EWOC.
  Returns the new NODE."
     (ewoc--set-buffer-bind-dll ewoc
!       (let
! 	 ((new-node
! 	     (ewoc--node-create 
! 		nil
! 		data)))
! 	 (ewoc--node-enter-before node new-node)
! 	 ;;Print the node only after it has been inserted.
! 	 (save-excursion
! 	    (goto-char (ewoc-location-safe node))
! 	    (ewoc--print-node 
! 	       new-node 
! 	       (or printer (ewoc--pretty-printer ewoc))))
! 	 new-node)))
  
  (defun ewoc-next (ewoc node)
    "Get the next node.
***************
*** 404,409 ****
--- 512,518 ----
        (if (apply map-function (ewoc--node-data node) args)
  	  (ewoc--refresh-node (ewoc--pretty-printer ewoc) node))
        (setq node (ewoc--node-next dll node)))))
+ (defalias 'ewoc-foreach ewoc-map)
  
  (defun ewoc-filter (ewoc predicate &rest args)
    "Remove all elements in EWOC for which PREDICATE returns nil.
***************
*** 440,450 ****
        nil)
  
       ;; Before second elem?
!      ((< pos (ewoc--node-start-marker (ewoc--node-nth dll 2)))
        (ewoc--node-nth dll 1))
  
       ;; After one-before-last elem?
!      ((>= pos (ewoc--node-start-marker (ewoc--node-nth dll -2)))
        (ewoc--node-nth dll -2))
  
       ;; We now know that pos is within a elem.
--- 549,559 ----
  	    nil)
  
  	 ;; Before second elem?
! 	 ((< pos (ewoc-location (ewoc--node-nth dll 2)))
  	    (ewoc--node-nth dll 1))
  
  	 ;; After one-before-last elem?
! 	 ((>= pos (ewoc-location (ewoc--node-nth dll -2)))
  	    (ewoc--node-nth dll -2))
  
  	 ;; We now know that pos is within a elem.
***************
*** 452,473 ****
        ;; Make an educated guess about which of the three known
        ;; node'es (the first, the last, or GUESS) is nearest.
        (let* ((best-guess (ewoc--node-nth dll 1))
! 	     (distance (abs (- pos (ewoc--node-start-marker best-guess)))))
  	(when guess
! 	  (let ((d (abs (- pos (ewoc--node-start-marker guess)))))
  	    (when (< d distance)
  	      (setq distance d)
  	      (setq best-guess guess))))
  
  	(let* ((g (ewoc--node-nth dll -1))	;Check the last elem
! 	       (d (abs (- pos (ewoc--node-start-marker g)))))
  	  (when (< d distance)
  	    (setq distance d)
  	    (setq best-guess g)))
  
  	(when (ewoc--last-node ewoc) ;Check "previous".
  	  (let* ((g (ewoc--last-node ewoc))
! 		 (d (abs (- pos (ewoc--node-start-marker g)))))
  	    (when (< d distance)
  	      (setq distance d)
  	      (setq best-guess g))))
--- 561,582 ----
  	    ;; Make an educated guess about which of the three known
  	    ;; node'es (the first, the last, or GUESS) is nearest.
  	    (let* ((best-guess (ewoc--node-nth dll 1))
! 		     (distance (abs (- pos (ewoc-location best-guess)))))
  	       (when guess
! 		  (let ((d (abs (- pos (ewoc-location guess)))))
  		     (when (< d distance)
  			(setq distance d)
  			(setq best-guess guess))))
  
  	       (let* ((g (ewoc--node-nth dll -1)) ;Check the last elem
! 			(d (abs (- pos (ewoc-location g)))))
  		  (when (< d distance)
  		     (setq distance d)
  		     (setq best-guess g)))
  
  	       (when (ewoc--last-node ewoc) ;Check "previous".
  		  (let* ((g (ewoc--last-node ewoc))
! 			   (d (abs (- pos (ewoc-location g)))))
  		     (when (< d distance)
  			(setq distance d)
  			(setq best-guess g))))
***************
*** 479,494 ****
  	(cond
  	 ;; Is pos after the guess?
  	 ((>= pos
! 	      (ewoc--node-start-marker best-guess))
  	  ;; Loop until we are exactly one node too far down...
! 	  (while (>= pos (ewoc--node-start-marker best-guess))
  	    (setq best-guess (ewoc--node-next dll best-guess)))
  	  ;; ...and return the previous node.
  	  (ewoc--node-prev dll best-guess))
  
  	 ;; Pos is before best-guess
  	 (t
! 	  (while (< pos (ewoc--node-start-marker best-guess))
  	    (setq best-guess (ewoc--node-prev dll best-guess)))
  	  best-guess)))))))
  
--- 588,603 ----
  	       (cond
  		  ;; Is pos after the guess?
  		  ((>= pos
! 		      (ewoc-location best-guess))
  		     ;; Loop until we are exactly one node too far down...
! 		     (while (>= pos (ewoc-location best-guess))
  			(setq best-guess (ewoc--node-next dll best-guess)))
  		     ;; ...and return the previous node.
  		     (ewoc--node-prev dll best-guess))
  
  		  ;; Pos is before best-guess
  		  (t
! 		     (while (< pos (ewoc-location best-guess))
  			(setq best-guess (ewoc--node-prev dll best-guess)))
  		     best-guess)))))))
  
***************
*** 507,513 ****
        ((node (ewoc-locate ewoc (point))))
      (when node
        ;; If we were past the last element, first jump to it.
!       (when (>= (point) (ewoc--node-start-marker (ewoc--node-right node)))
  	(setq arg (1- arg)))
        (while (and node (> arg 0))
  	(setq arg (1- arg))
--- 616,622 ----
        ((node (ewoc-locate ewoc (point))))
        (when node
  	 ;; If we were past the last element, first jump to it.
! 	 (when (>= (point) (ewoc-location (ewoc--node-right node)))
  	    (setq arg (1- arg)))
  	 (while (and node (> arg 0))
  	    (setq arg (1- arg))
***************
*** 533,539 ****
  (defun ewoc-goto-node (ewoc node)
    "Move point to NODE."
    (ewoc--set-buffer-bind-dll ewoc
!     (goto-char (ewoc--node-start-marker node))
      (if goal-column (move-to-column goal-column))
      (setf (ewoc--last-node ewoc) node)))
  
--- 642,648 ----
  (defun ewoc-goto-node (ewoc node)
     "Move point to NODE."
     (ewoc--set-buffer-bind-dll ewoc
!       (goto-char (ewoc-location node))
        (if goal-column (move-to-column goal-column))
        (setf (ewoc--last-node ewoc) node)))
  
***************
*** 545,562 ****
  number of elements needs to be refreshed."
    (ewoc--set-buffer-bind-dll-let* ewoc
        ((footer (ewoc--footer ewoc)))
!     (let ((inhibit-read-only t))
!       (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1))
! 		     (ewoc--node-start-marker footer))
!       (goto-char (ewoc--node-start-marker footer))
!       (let ((node (ewoc--node-nth dll 1)))
  	(while (not (eq node footer))
! 	  (set-marker (ewoc--node-start-marker node) (point))
! 	  (funcall (ewoc--pretty-printer ewoc)
! 		   (ewoc--node-data node))
! 	  (insert "\n")
  	  (setq node (ewoc--node-next dll node)))))
!     (set-marker (ewoc--node-start-marker footer) (point))))
  
  (defun ewoc-collect (ewoc predicate &rest args)
    "Select elements from EWOC using PREDICATE.
--- 654,674 ----
  number of elements needs to be refreshed."
     (ewoc--set-buffer-bind-dll-let* ewoc
        ((footer (ewoc--footer ewoc)))
!       (let ((inhibit-read-only t)
! 	      (first-node (ewoc--node-nth dll 1)))
! 	 (delete-region 
! 	    (ewoc-location first-node)
! 	    (ewoc-location footer))
! 	 (goto-char (ewoc-location footer))
! 	 (let ((node first-node)
! 		 (pp (ewoc--pretty-printer ewoc)))
  	    (while (not (eq node footer))
! 	       (ewoc--print-anew node pp)
  	       (setq node (ewoc--node-next dll node)))))
! 
!       ;;Finally, set the last marker.  It is not neccessarily
!       ;;footer's own marker because footer may be blank.
!       (set-marker (ewoc-location footer) (point))))
  
  (defun ewoc-collect (ewoc predicate &rest args)
    "Select elements from EWOC using PREDICATE.
***************
*** 595,602 ****
    "Set the HEADER and FOOTER of EWOC."
    (setf (ewoc--node-data (ewoc--header ewoc)) header)
    (setf (ewoc--node-data (ewoc--footer ewoc)) footer)
!   (ewoc--refresh-node (lambda (x) (insert header)) (ewoc--header ewoc))
!   (ewoc--refresh-node (lambda (x) (insert footer)) (ewoc--footer ewoc)))
  
  \f
  (provide 'ewoc)
--- 707,714 ----
    "Set the HEADER and FOOTER of EWOC."
    (setf (ewoc--node-data (ewoc--header ewoc)) header)
    (setf (ewoc--node-data (ewoc--footer ewoc)) footer)
!   (ewoc--refresh-node #'insert (ewoc--header ewoc))
!   (ewoc--refresh-node #'insert (ewoc--footer ewoc)))
  
  \f
  (provide 'ewoc)

Diff finished at Tue Dec  8 22:58:57

Re: ewoc patch (Was wrong patch, right one attached)

[Tom Breton (Tehom)]

[-- Attachment #1: Type: text/plain, Size: 114 bytes --]

Oops, the diff I attached has an error.  The right one is attached to this
message.

        Tom Breton (Tehom)

[-- Attachment #2: ewoc.el.4.diff --]
[-- Type: application/octet-stream, Size: 20337 bytes --]

cd /home/tehom/projects/emtest/lisp/viewers/
diff -c -b /home/tehom/emacs-21.4/lisp/emacs-lisp/ewoc.el /home/tehom/projects/emtest/lisp/viewers/ewoc.el
*** /home/tehom/emacs-21.4/lisp/emacs-lisp/ewoc.el	2001-07-16 08:22:59.000000000 -0400
--- /home/tehom/projects/emtest/lisp/viewers/ewoc.el	2009-12-08 23:15:16.000000000 -0500
***************
*** 129,134 ****
--- 129,136 ----
  
  (eval-when-compile (require 'cl))	;because of CL compiler macros
  
+ (defconst ewoc-version "2.0")
+ 
  ;; The doubly linked list is implemented as a circular list
  ;; with a dummy node first and last. The dummy node is used as
  ;; "the dll" (or rather is the dll handle passed around).
***************
*** 197,215 ****
        (setq n (1- n)))
      (unless (eq dll node) node)))
  
- (defun ewoc-location (node)
-   "Return the start location of NODE."
-   (ewoc--node-start-marker node))
- 
  \f
  ;;; The ewoc data type
  
  (defstruct (ewoc
  	    (:constructor nil)
  	    (:constructor ewoc--create
! 			  (buffer pretty-printer header footer dll))
  	    (:conc-name ewoc--))
!   buffer pretty-printer header footer dll last-node)
  
  (defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
    "Execute FORMS with ewoc--buffer selected as current buffer,
--- 199,216 ----
        (setq n (1- n)))
      (unless (eq dll node) node)))
  
  \f
  ;;; The ewoc data type
  
  (defstruct (ewoc
  	    (:constructor nil)
  	    (:constructor ewoc--create
! 			  (buffer pretty-printer header footer dll
! 			     separator))
  	    (:conc-name ewoc--))
!   buffer pretty-printer header footer dll last-node separator)
! 
! 
  
  (defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
    "Execute FORMS with ewoc--buffer selected as current buffer,
***************
*** 238,329 ****
  	      (eq node (ewoc--footer ewoc)))
      node))
  
- 
- (defun ewoc--create-node (data pretty-printer pos)
-   "Call PRETTY-PRINTER with point set at POS in current buffer.
- Remember the start position. Create a wrapper containing that
- start position and the element DATA."
-   (save-excursion
-     ;; Remember the position as a number so that it doesn't move
-     ;; when we insert the string.
-     (when (markerp pos) (setq pos (marker-position pos)))
-     (goto-char pos)
-     (let ((inhibit-read-only t))
-       ;; Insert the trailing newline using insert-before-markers
-       ;; so that the start position for the next element is updated.
-       (insert-before-markers ?\n)
-       ;; Move back, and call the pretty-printer.
-       (backward-char 1)
-       (funcall pretty-printer data)
-       (ewoc--node-create (copy-marker pos) data))))
- 
- 
  (defun ewoc--delete-node-internal (ewoc node)
    "Delete a data string from EWOC.
  Can not be used on the footer. Returns the wrapper that is deleted.
  The start-marker in the wrapper is set to nil, so that it doesn't
  consume any more resources."
    (let ((dll (ewoc--dll ewoc))
  	(inhibit-read-only t))
!     ;; If we are about to delete the node pointed at by last-node,
!     ;; set last-node to nil.
      (if (eq (ewoc--last-node ewoc) node)
  	(setf (ewoc--last-node ewoc) nil))
! 
!     (delete-region (ewoc--node-start-marker node)
! 		   (ewoc--node-start-marker (ewoc--node-next dll node)))
!     (set-marker (ewoc--node-start-marker node) nil)
!     ;; Delete the node, and return the wrapper.
!     (ewoc--node-delete node)))
! 
  
  (defun ewoc--refresh-node (pp node)
    "Redisplay the element represented by NODE using the pretty-printer PP."
    (let ((inhibit-read-only t))
      (save-excursion
!       ;; First, remove the string from the buffer:
!       (delete-region (ewoc--node-start-marker node)
! 		     (1- (marker-position
! 			  (ewoc--node-start-marker (ewoc--node-right node)))))
!       ;; Calculate and insert the string.
!       (goto-char (ewoc--node-start-marker node))
!       (funcall pp (ewoc--node-data node)))))
  \f
  ;;; ===========================================================================
  ;;;                  Public members of the Ewoc package
  
  
! (defun ewoc-create (pretty-printer &optional header footer)
    "Create an empty ewoc.
  
  The ewoc will be inserted in the current buffer at the current position.
  
  PRETTY-PRINTER should be a function that takes one argument, an
  element, and inserts a string representing it in the buffer (at
! point). The string PRETTY-PRINTER inserts may be empty or span
! several linse. A trailing newline will always be inserted
! automatically. The PRETTY-PRINTER should use insert, and not
! insert-before-markers.
  
! Optional third argument HEADER is a string that will always be
  present at the top of the ewoc. HEADER should end with a
! newline.  Optionaly fourth argument FOOTER is similar, and will
! be inserted at the bottom of the ewoc."
!   (let ((new-ewoc
! 	 (ewoc--create (current-buffer)
! 		       pretty-printer nil nil (ewoc--dll-create)))
  	(pos (point)))
      (ewoc--set-buffer-bind-dll new-ewoc
        ;; Set default values
        (unless header (setq header ""))
        (unless footer (setq footer ""))
        (setf (ewoc--node-start-marker dll) (copy-marker pos))
!       (let ((foot (ewoc--create-node footer (lambda (x) (insert footer)) pos))
! 	    (head (ewoc--create-node header (lambda (x) (insert header)) pos)))
! 	(ewoc--node-enter-first dll head)
! 	(ewoc--node-enter-last  dll foot)
  	(setf (ewoc--header new-ewoc) head)
  	(setf (ewoc--footer new-ewoc) foot)))
      ;; Return the ewoc
      new-ewoc))
  
--- 239,430 ----
  	      (eq node (ewoc--footer ewoc)))
      node))
  
  (defun ewoc--delete-node-internal (ewoc node)
     "Delete a data string from EWOC.
  Can not be used on the footer. Returns the wrapper that is deleted.
  The start-marker in the wrapper is set to nil, so that it doesn't
  consume any more resources."
+    (when (ewoc--node-start-marker node)
        (let ((dll (ewoc--dll ewoc))
  	      (inhibit-read-only t))
! 	 ;; If we are about to delete the node pointed at by
! 	 ;; last-node, set last-node to nil.
  	 (if (eq (ewoc--last-node ewoc) node)
  	    (setf (ewoc--last-node ewoc) nil))
! 	 (ewoc--delete-node-text node)
! 	 ;; Delete the node from the dll and return the wrapper.
! 	 (ewoc--node-delete node))))
  
  (defun ewoc--refresh-node (pp node)
        "Redisplay the element represented by NODE using the pretty-printer PP."
+       (assert node)
        (let ((inhibit-read-only t))
  	 (save-excursion
! 	    (goto-char (ewoc-location-safe node))
! 	    (ewoc--delete-node-text node)
! 	    (ewoc--print-anew node pp))))
! 
! \f
! ;;; ===========================================================================
! ;;;                  Node location
! 
! (defun ewoc--raw-location (node)
!       "Return the start location of NODE.
! If NODE is empty, return nil."
!       (ewoc--node-start-marker node))
! 
! (defun ewoc--next-printed-node (node)
!    "Return the next non-empty node after NODE."
!    ;;This loop will terminate because we set at least one
!    ;;start-marker in the ewoc when creating it.
!    (do
!       ((node-after 
! 	  (ewoc--node-right node) 
! 	  (ewoc--node-right node-after)))
!       (
! 	 (ewoc--node-start-marker node-after)
! 	 node-after)))
!    
! (defun ewoc--next-start-marker (node)
!    "Return the first start marker after NODE."
!    (ewoc--node-start-marker
!       (ewoc--next-printed-node node)))
! 
! (defun ewoc-location (node)
!    "Return the start location of NODE.
! If NODE is empty, return the start marker of the next non-empty node."
!    (or
!       (ewoc--raw-location node)
!       (ewoc--next-start-marker node)))
! 
! ;;A start-marker's insertion-type should already be `t', but some
! ;;callers want to be 100% sure it is, so this function exists.
! (defun ewoc-location-safe (node)
!    "Get NODE's start location.  
! Also set the start-marker's insertion type to `t' so that it will stay
! after any text inserted at that point."
! 
!    (let
!       ((next-start-marker (ewoc-location node)))
!       (set-marker-insertion-type next-start-marker t)
!       next-start-marker))
! 
! \f
! ;;; ===========================================================================
! ;;;                  Printing and unprinting
! 
! (defun ewoc--mark-node-empty (node)
!    "Mark NODE empty (but don't empty it, assume it was emptied)
! INTERNAL USE ONLY."
!    (let
!       ((start-marker (ewoc--node-start-marker node)))
!       (when start-marker
! 	 (set-marker start-marker nil)
! 	 (setf
! 	    (ewoc--node-start-marker node)
! 	    nil))))
! 
! (defun ewoc--delete-node-text (node)
!    "Delete a node's text."
!    (when
!       (ewoc--node-start-marker node)
!       (delete-region
! 	 (ewoc--node-start-marker node)
! 	 (ewoc--next-start-marker node))
!       (ewoc--mark-node-empty node)))
! 
! (defun ewoc--print-anew (node pp)
!    "Print a node that was erased."
!    (ewoc--mark-node-empty node)
!    (ewoc--print-node node pp))
! 
!    
! (defun ewoc--print-node (node printer)
!    "Print NODE at point using PRINTER.
! Set NODE's start-marker accordingly."
!    ;;Only print if node is currently empty
!    (when (ewoc--node-start-marker node)
!       (error "ewoc--print-node called with a node that's already printed"))
! 
!    (let
!       (
! 	 (start-pos (point))
! 	 (inhibit-read-only t))
! 
!       (funcall printer (ewoc-data node))
!       (let
! 	 ((separator (ewoc--separator ewoc)))
! 	 (when separator (insert separator)))
! 
!       ;;Only set up this node as non-empty if it actually is
!       ;;non-empty.
!       (unless
! 	 (= start-pos (point))
! 	 ;;Set its start-marker to the position we started
! 	 ;;printing from.
! 	 (setf 
! 	    (ewoc--node-start-marker node)
! 	    (copy-marker start-pos t)))))
! 
  \f
  ;;; ===========================================================================
  ;;;                  Public members of the Ewoc package
  
  
! (defun ewoc-create (pretty-printer &optional header footer separator)
!    
    "Create an empty ewoc.
  
  The ewoc will be inserted in the current buffer at the current position.
  
  PRETTY-PRINTER should be a function that takes one argument, an
  element, and inserts a string representing it in the buffer (at
! point). The string PRETTY-PRINTER inserts may be empty or span several
! linse. SEPARATOR will be inserted automatically. The PRETTY-PRINTER
! should use insert, and not insert-before-markers.
  
! Optional second argument HEADER is a string that will always be
  present at the top of the ewoc. HEADER should end with a
! newline.  Optional third argument FOOTER is similar, and will
! be inserted at the bottom of the ewoc.
! 
! Optional fourth argument SEPARATOR is a string.  It will be inserted
! after each entry and after header and footer.  It defaults to one
! newline."
! 
!   (let* (
! 	   (separator
! 	      (cond
! 		 ((null separator) "\n")
! 		 ((stringp separator)
! 		    (if (string= separator "") nil separator))
! 		 (t (error "ewoc-create: separator %s is not a string"
! 		       separator))))
! 	   (new-ewoc
! 	      (ewoc--create 
! 		 (current-buffer)
! 		 pretty-printer
! 		 nil nil (ewoc--dll-create)
! 		 separator))
  	   (pos (point)))
       (ewoc--set-buffer-bind-dll new-ewoc
  	;; Set default values
  	(unless header (setq header ""))
  	(unless footer (setq footer ""))
  	(setf (ewoc--node-start-marker dll) (copy-marker pos))
! 
! 	(let*
! 	   ((foot 
! 	       (ewoc-enter-before
! 		  new-ewoc dll footer #'insert))
! 	      
! 	      (head 
! 		 (ewoc-enter-before
! 		    new-ewoc foot header #'insert)))
! 	   
  	   (setf (ewoc--header new-ewoc) head)
  	   (setf (ewoc--footer new-ewoc) foot)))
+      
       ;; Return the ewoc
       new-ewoc))
  
***************
*** 346,361 ****
    (ewoc--set-buffer-bind-dll ewoc
      (ewoc-enter-before ewoc (ewoc--node-next dll node) data)))
  
! (defun ewoc-enter-before (ewoc node data)
!   "Enter a new element DATA before NODE in EWOC.
  Returns the new NODE."
    (ewoc--set-buffer-bind-dll ewoc
!     (ewoc--node-enter-before
!      node
!      (ewoc--create-node
!       data
!       (ewoc--pretty-printer ewoc)
!       (ewoc--node-start-marker node)))))
  
  (defun ewoc-next (ewoc node)
    "Get the next node.
--- 447,469 ----
    (ewoc--set-buffer-bind-dll ewoc
      (ewoc-enter-before ewoc (ewoc--node-next dll node) data)))
  
! (defun ewoc-enter-before (ewoc node data &optional printer)
!    "Create a new element DATA before NODE in EWOC.
  Returns the new NODE."
     (ewoc--set-buffer-bind-dll ewoc
!       (let
! 	 ((new-node
! 	     (ewoc--node-create 
! 		nil
! 		data)))
! 	 (ewoc--node-enter-before node new-node)
! 	 ;;Print the node only after it has been inserted.
! 	 (save-excursion
! 	    (goto-char (ewoc-location-safe node))
! 	    (ewoc--print-node 
! 	       new-node 
! 	       (or printer (ewoc--pretty-printer ewoc))))
! 	 new-node)))
  
  (defun ewoc-next (ewoc node)
    "Get the next node.
***************
*** 404,409 ****
--- 512,518 ----
        (if (apply map-function (ewoc--node-data node) args)
  	  (ewoc--refresh-node (ewoc--pretty-printer ewoc) node))
        (setq node (ewoc--node-next dll node)))))
+ (defalias 'ewoc-foreach 'ewoc-map)
  
  (defun ewoc-filter (ewoc predicate &rest args)
    "Remove all elements in EWOC for which PREDICATE returns nil.
***************
*** 440,450 ****
        nil)
  
       ;; Before second elem?
!      ((< pos (ewoc--node-start-marker (ewoc--node-nth dll 2)))
        (ewoc--node-nth dll 1))
  
       ;; After one-before-last elem?
!      ((>= pos (ewoc--node-start-marker (ewoc--node-nth dll -2)))
        (ewoc--node-nth dll -2))
  
       ;; We now know that pos is within a elem.
--- 549,559 ----
  	    nil)
  
  	 ;; Before second elem?
! 	 ((< pos (ewoc-location (ewoc--node-nth dll 2)))
  	    (ewoc--node-nth dll 1))
  
  	 ;; After one-before-last elem?
! 	 ((>= pos (ewoc-location (ewoc--node-nth dll -2)))
  	    (ewoc--node-nth dll -2))
  
  	 ;; We now know that pos is within a elem.
***************
*** 452,473 ****
        ;; Make an educated guess about which of the three known
        ;; node'es (the first, the last, or GUESS) is nearest.
        (let* ((best-guess (ewoc--node-nth dll 1))
! 	     (distance (abs (- pos (ewoc--node-start-marker best-guess)))))
  	(when guess
! 	  (let ((d (abs (- pos (ewoc--node-start-marker guess)))))
  	    (when (< d distance)
  	      (setq distance d)
  	      (setq best-guess guess))))
  
  	(let* ((g (ewoc--node-nth dll -1))	;Check the last elem
! 	       (d (abs (- pos (ewoc--node-start-marker g)))))
  	  (when (< d distance)
  	    (setq distance d)
  	    (setq best-guess g)))
  
  	(when (ewoc--last-node ewoc) ;Check "previous".
  	  (let* ((g (ewoc--last-node ewoc))
! 		 (d (abs (- pos (ewoc--node-start-marker g)))))
  	    (when (< d distance)
  	      (setq distance d)
  	      (setq best-guess g))))
--- 561,582 ----
  	    ;; Make an educated guess about which of the three known
  	    ;; node'es (the first, the last, or GUESS) is nearest.
  	    (let* ((best-guess (ewoc--node-nth dll 1))
! 		     (distance (abs (- pos (ewoc-location best-guess)))))
  	       (when guess
! 		  (let ((d (abs (- pos (ewoc-location guess)))))
  		     (when (< d distance)
  			(setq distance d)
  			(setq best-guess guess))))
  
  	       (let* ((g (ewoc--node-nth dll -1)) ;Check the last elem
! 			(d (abs (- pos (ewoc-location g)))))
  		  (when (< d distance)
  		     (setq distance d)
  		     (setq best-guess g)))
  
  	       (when (ewoc--last-node ewoc) ;Check "previous".
  		  (let* ((g (ewoc--last-node ewoc))
! 			   (d (abs (- pos (ewoc-location g)))))
  		     (when (< d distance)
  			(setq distance d)
  			(setq best-guess g))))
***************
*** 479,494 ****
  	(cond
  	 ;; Is pos after the guess?
  	 ((>= pos
! 	      (ewoc--node-start-marker best-guess))
  	  ;; Loop until we are exactly one node too far down...
! 	  (while (>= pos (ewoc--node-start-marker best-guess))
  	    (setq best-guess (ewoc--node-next dll best-guess)))
  	  ;; ...and return the previous node.
  	  (ewoc--node-prev dll best-guess))
  
  	 ;; Pos is before best-guess
  	 (t
! 	  (while (< pos (ewoc--node-start-marker best-guess))
  	    (setq best-guess (ewoc--node-prev dll best-guess)))
  	  best-guess)))))))
  
--- 588,603 ----
  	       (cond
  		  ;; Is pos after the guess?
  		  ((>= pos
! 		      (ewoc-location best-guess))
  		     ;; Loop until we are exactly one node too far down...
! 		     (while (>= pos (ewoc-location best-guess))
  			(setq best-guess (ewoc--node-next dll best-guess)))
  		     ;; ...and return the previous node.
  		     (ewoc--node-prev dll best-guess))
  
  		  ;; Pos is before best-guess
  		  (t
! 		     (while (< pos (ewoc-location best-guess))
  			(setq best-guess (ewoc--node-prev dll best-guess)))
  		     best-guess)))))))
  
***************
*** 507,513 ****
        ((node (ewoc-locate ewoc (point))))
      (when node
        ;; If we were past the last element, first jump to it.
!       (when (>= (point) (ewoc--node-start-marker (ewoc--node-right node)))
  	(setq arg (1- arg)))
        (while (and node (> arg 0))
  	(setq arg (1- arg))
--- 616,622 ----
        ((node (ewoc-locate ewoc (point))))
        (when node
  	 ;; If we were past the last element, first jump to it.
! 	 (when (>= (point) (ewoc-location (ewoc--node-right node)))
  	    (setq arg (1- arg)))
  	 (while (and node (> arg 0))
  	    (setq arg (1- arg))
***************
*** 533,539 ****
  (defun ewoc-goto-node (ewoc node)
    "Move point to NODE."
    (ewoc--set-buffer-bind-dll ewoc
!     (goto-char (ewoc--node-start-marker node))
      (if goal-column (move-to-column goal-column))
      (setf (ewoc--last-node ewoc) node)))
  
--- 642,648 ----
  (defun ewoc-goto-node (ewoc node)
     "Move point to NODE."
     (ewoc--set-buffer-bind-dll ewoc
!       (goto-char (ewoc-location node))
        (if goal-column (move-to-column goal-column))
        (setf (ewoc--last-node ewoc) node)))
  
***************
*** 545,562 ****
  number of elements needs to be refreshed."
    (ewoc--set-buffer-bind-dll-let* ewoc
        ((footer (ewoc--footer ewoc)))
!     (let ((inhibit-read-only t))
!       (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1))
! 		     (ewoc--node-start-marker footer))
!       (goto-char (ewoc--node-start-marker footer))
!       (let ((node (ewoc--node-nth dll 1)))
  	(while (not (eq node footer))
! 	  (set-marker (ewoc--node-start-marker node) (point))
! 	  (funcall (ewoc--pretty-printer ewoc)
! 		   (ewoc--node-data node))
! 	  (insert "\n")
  	  (setq node (ewoc--node-next dll node)))))
!     (set-marker (ewoc--node-start-marker footer) (point))))
  
  (defun ewoc-collect (ewoc predicate &rest args)
    "Select elements from EWOC using PREDICATE.
--- 654,674 ----
  number of elements needs to be refreshed."
     (ewoc--set-buffer-bind-dll-let* ewoc
        ((footer (ewoc--footer ewoc)))
!       (let ((inhibit-read-only t)
! 	      (first-node (ewoc--node-nth dll 1)))
! 	 (delete-region 
! 	    (ewoc-location first-node)
! 	    (ewoc-location footer))
! 	 (goto-char (ewoc-location footer))
! 	 (let ((node first-node)
! 		 (pp (ewoc--pretty-printer ewoc)))
  	    (while (not (eq node footer))
! 	       (ewoc--print-anew node pp)
  	       (setq node (ewoc--node-next dll node)))))
! 
!       ;;Finally, set the last marker.  It is not neccessarily
!       ;;footer's own marker because footer may be blank.
!       (set-marker (ewoc-location footer) (point))))
  
  (defun ewoc-collect (ewoc predicate &rest args)
    "Select elements from EWOC using PREDICATE.
***************
*** 595,602 ****
    "Set the HEADER and FOOTER of EWOC."
    (setf (ewoc--node-data (ewoc--header ewoc)) header)
    (setf (ewoc--node-data (ewoc--footer ewoc)) footer)
!   (ewoc--refresh-node (lambda (x) (insert header)) (ewoc--header ewoc))
!   (ewoc--refresh-node (lambda (x) (insert footer)) (ewoc--footer ewoc)))
  
  \f
  (provide 'ewoc)
--- 707,714 ----
    "Set the HEADER and FOOTER of EWOC."
    (setf (ewoc--node-data (ewoc--header ewoc)) header)
    (setf (ewoc--node-data (ewoc--footer ewoc)) footer)
!   (ewoc--refresh-node #'insert (ewoc--header ewoc))
!   (ewoc--refresh-node #'insert (ewoc--footer ewoc)))
  
  \f
  (provide 'ewoc)

Diff finished at Tue Dec  8 23:15:42

Re: ewoc patch

[Stefan Monnier]

> I like the ewoc package, but I found it somewhat inflexible.  I am
> submitting this diff (attached) in the hope of improving it.

> In particular:

>  * ewoc always wants every entry to be separated from the other
>    entries by a newline.

>  * It does not work properly with blank entries.  These become a real
>    problem when a blank separator is allowed.  Nodes often get printed
>    out of order.

Not sure what you mean by "blank" entries.  If you mean entries which
don't get printed (i.e. "invisilbe" entries), then yes, it's
a limitation that it would be good to lift.  IIUC you lift it by:

> * Design: Nodes that have no text have no start marker.

which I think is a good solution (when I tried to lift that limitation
it didn't occur to me, so I tried to manually separate the markers that
needed to move from those that needed to stay put and it was messy).

>  * ewoc-map is slightly misnamed; it doesn't map, it's more like
>    for-each.

It's the historical name.  To fit with other macros (like dotimes,
dolist), we could call it ewoc-do rather than ewoc-foreach.

>  * Added a version number.  I didn't have much to go on, so I just
>    said it was "2.0".  I will gladly change it to correspond to an
>    official version number.

The Emacs package generally doesn't like version numbers, so I'd rather
not introduce one here, unless there's really a good reason for it.

>  * Added a new field to the ewoc, "separator".  That's the string that
>    separates entries.  It defaults to "\n".

IIUC it can also be the empty string, right?  IIUC, the current ewoc.el
already makes it possible to get rid of the separator.  Making it
an argument might be a good idea as well.

> Testing:

>  * Created a test suite.  The suite relies on rtest, which
>    unfortunately is still between releasable versions.

We still don't have a testsuite in Emacs, but we'll gladly add the
testsuite to our repository (we have a `test' subdirectory for that).

> diff -c -b /home/tehom/emacs-21.4/lisp/emacs-lisp/ewoc.el /home/tehom/projects/emtest/lisp/viewers/ewoc.el
> --- /home/tehom/emacs-21.4/lisp/emacs-lisp/ewoc.el	2001-07-16 08:22:59.000000000 -0400
> +++ /home/tehom/projects/emtest/lisp/viewers/ewoc.el	2009-12-08 22:57:46.000000000 -0500
> @@ -129,6 +129,8 @@
 
Emacs-21.4 is rather old.  ewoc hasn't seen much development, but it's
still substantially different.  Could you try and adapt your changes to
our latest code?


        Stefan

Re: ewoc patch

[Tom Breton (Tehom)]

> Not sure what you mean by "blank" entries.  If you mean entries which
> don't get printed (i.e. "invisilbe" entries), then yes, it's
> a limitation that it would be good to lift.  IIUC you lift it by:

Yes, I meant entries that print nothing and have no separator.

>> * Design: Nodes that have no text have no start marker.
>
> which I think is a good solution (when I tried to lift that limitation
> it didn't occur to me, so I tried to manually separate the markers that
> needed to move from those that needed to stay put and it was messy).

I bet it was messy.  That was the first approach I tried.

>>  * ewoc-map is slightly misnamed; it doesn't map, it's more like
>>    for-each.
>
> It's the historical name.  To fit with other macros (like dotimes,
> dolist), we could call it ewoc-do rather than ewoc-foreach.

Fair enough.  But ISTM that while `ewoc-for-each' can have the same
signature as `ewoc-map' has now, `ewoc-do' would be expected to have a
signature like dolist and dotimes.  Ie, to be used like:

(ewoc-do (element ewoc)
  (do-stuff-to element))

So ewoc-for-each was just an alias but ewoc-do would require more.

>>  * Added a version number.  I didn't have much to go on, so I just
>>    said it was "2.0".  I will gladly change it to correspond to an
>>    official version number.
>
> The Emacs package generally doesn't like version numbers, so I'd rather
> not introduce one here, unless there's really a good reason for it.

I added it so that other packages that wanted or needed a variable
separator could tell whether it was available.  Otherwise they would make
errors if an old ewoc.el was loaded.  If you have a better way in mind,
I'll use it.

>>  * Added a new field to the ewoc, "separator".  That's the string that
>>    separates entries.  It defaults to "\n".
>
> IIUC it can also be the empty string, right?  IIUC, the current ewoc.el
> already makes it possible to get rid of the separator.  Making it
> an argument might be a good idea as well.

Yes, I think so too.

>> Testing:
>
>>  * Created a test suite.  The suite relies on rtest, which
>>    unfortunately is still between releasable versions.
>
> We still don't have a testsuite in Emacs, but we'll gladly add the
> testsuite to our repository (we have a `test' subdirectory for that).

Sure.  But it uses my tester package rtest; there is an old version of
rtest  out there but I'm using my new version that is still in flux. 
(Which, circularly, is the reason I wanted to make ewoc more flexible)

>> diff -c -b /home/tehom/emacs-21.4/lisp/emacs-lisp/ewoc.el
>> /home/tehom/projects/emtest/lisp/viewe

Will emacs 22.2 be sufficient?

Tom Breton (Tehom)

Re: ewoc patch

[Stefan Monnier]

> Fair enough.  But ISTM that while `ewoc-for-each' can have the same
> signature as `ewoc-map' has now, `ewoc-do' would be expected to have a
> signature like dolist and dotimes.  Ie, to be used like:

> (ewoc-do (element ewoc)
>   (do-stuff-to element))

> So ewoc-for-each was just an alias but ewoc-do would require more.

Sure.  I don't have a strong opinion on that one.

>> The Emacs package generally doesn't like version numbers, so I'd rather
>> not introduce one here, unless there's really a good reason for it.
> I added it so that other packages that wanted or needed a variable
> separator could tell whether it was available.  Otherwise they would make
> errors if an old ewoc.el was loaded.  If you have a better way in mind,
> I'll use it.

Better just try to use the feature and detect when it's not available.
E.g. check the feature's presence via `fboundp' or by trying the call
with the extra parametwer and catch the
`wrong-number-of-arguments' error.

>> We still don't have a testsuite in Emacs, but we'll gladly add the
>> testsuite to our repository (we have a `test' subdirectory for that).
> Sure.  But it uses my tester package rtest; there is an old version of
> rtest out there but I'm using my new version that is still in flux.
> (Which, circularly, is the reason I wanted to make ewoc more flexible)

I understand.  It's OK if the tests can't be run as-is.

>>> diff -c -b /home/tehom/emacs-21.4/lisp/emacs-lisp/ewoc.el
>>> /home/tehom/projects/emtest/lisp/viewe
> Will emacs 22.2 be sufficient?

No, please use the latest CVS version.  It's not like it's hard to get
from the browse-cvs area.


        Stefan

Re: ewoc patch

[Tom Breton (Tehom)]

I have, as you asked, adapted my changes for the latest CVS ewoc, for
emacs 23.1.  A few remarks:

How do you prefer to handle the part of the ewoc-create interface that
gives separator?  I can see several ways of proceeding:
 * Add another optional argument.  So there'd be both "nosep" and
   "separator"
   * Con: It's ugly to have 2 arguments with strongly overlapping
     meanings.
   * Con: Confusing if the given arguments disagree.
 * Replace argument "nosep" with "separator"
   * Con: Breaks backward compatibility.
   * Pro: Suffices to control all the variability
 * Keep only "nosep" as an argument.
   * Con: The flexibility is not available, though it exists internally.
 * Provide two function signatures; maybe name the other
   `ewoc-create*'.
   * Con: Makes the interface a little bigger.


>>> The Emacs package generally doesn't like version numbers, so I'd rather
>>> not introduce one here, unless there's really a good reason for it.
>> I added it so that other packages that wanted or needed a variable
>> separator could tell whether it was available.  Otherwise they would
>> make
>> errors if an old ewoc.el was loaded.  If you have a better way in mind,
>> I'll use it.
>
> Better just try to use the feature and detect when it's not available.
> E.g. check the feature's presence via `fboundp' or by trying the call
> with the extra parametwer and catch the
> `wrong-number-of-arguments' error.

I'm not sure that would suffice.  ewoc-create is fbound in any case.  That
leaves us with trying ewoc-create and catching the error.  My fear is that
a client's call to ewoc-create would not naturally occur at a good time
for this.  Ie, a client would appear to load correctly, would be started
by the user, and only then realize that it was relying on something that
wasn't available.

>>> We still don't have a testsuite in Emacs, but we'll gladly add the
>>> testsuite to our repository (we have a `test' subdirectory for that).
>> Sure.  But it uses my tester package rtest; there is an old version of
>> rtest out there but I'm using my new version that is still in flux.
>> (Which, circularly, is the reason I wanted to make ewoc more flexible)
>
> I understand.  It's OK if the tests can't be run as-is.

OK.  I just added tests for ewoc-do as well.  I will submit the test code.

Thanks for your help,

Tom Breton (Tehom)

Re: ewoc patch

[Stefan Monnier]

> How do you prefer to handle the part of the ewoc-create interface that
> gives separator?  I can see several ways of proceeding:
>  * Add another optional argument.  So there'd be both "nosep" and
>    "separator"
>    * Con: It's ugly to have 2 arguments with strongly overlapping
>      meanings.
>    * Con: Confusing if the given arguments disagree.
>  * Replace argument "nosep" with "separator"
>    * Con: Breaks backward compatibility.
>    * Pro: Suffices to control all the variability
>  * Keep only "nosep" as an argument.
>    * Con: The flexibility is not available, though it exists internally.
>  * Provide two function signatures; maybe name the other
>    `ewoc-create*'.
>    * Con: Makes the interface a little bigger.

Keep only `separator', but with the added twist that a non-string,
non-nil argument means the empty string (aka mean "nosep").  That should
preserve backward compatibility with a mostly clean API.

>>>> The Emacs package generally doesn't like version numbers, so I'd rather
>>>> not introduce one here, unless there's really a good reason for it.
>>> I added it so that other packages that wanted or needed a variable
>>> separator could tell whether it was available.  Otherwise they would
>>> make
>>> errors if an old ewoc.el was loaded.  If you have a better way in mind,
>>> I'll use it.
>> Better just try to use the feature and detect when it's not available.
>> E.g. check the feature's presence via `fboundp' or by trying the call
>> with the extra parametwer and catch the
>> `wrong-number-of-arguments' error.
> I'm not sure that would suffice.  ewoc-create is fbound in any case.  That
> leaves us with trying ewoc-create and catching the error.  My fear is that
> a client's call to ewoc-create would not naturally occur at a good time
> for this.  Ie, a client would appear to load correctly, would be started
> by the user, and only then realize that it was relying on something that
> wasn't available.

I think you're worrying for no good reason.  If you really want to
handle version dependencies right, you don't want it in a Lisp variable
but in a header understood and processed by some package manager (ELPA,
for instace).  Otherwise, you'll have to deal (one way or another) with
runtime checks, and in most cases the calling package will simply not
work with an older version.


        Stefan

Re: ewoc patch

[Tom Breton (Tehom)]

[-- Attachment #1: Type: text/plain, Size: 981 bytes --]

> Keep only `separator', but with the added twist that a non-string,
> non-nil argument means the empty string (aka mean "nosep").  That should
> preserve backward compatibility with a mostly clean API.

Done.

> I think you're worrying for no good reason.  If you really want to
> handle version dependencies right, you don't want it in a Lisp variable
> but in a header understood and processed by some package manager (ELPA,
> for instace).  Otherwise, you'll have to deal (one way or another) with
> runtime checks, and in most cases the calling package will simply not
> work with an older version.

Yes, I have to deal with runtime checks.

Anyways, I have replaced the version variable with a variable called
`ewoc-provides-variable-separator' that is bound just if ewoc provides
a variable separator.  I hope that will satisfy.

Attached is
 * new ewoc patch against 23.1
 * test file

Thank you for your help, Stefan.

        Tom Breton (Tehom)

[-- Attachment #2: ewoc.el.5.diff --]
[-- Type: application/octet-stream, Size: 21503 bytes --]

cd /home/tehom/projects/emtest/lisp/viewers/
diff -c -b /home/tehom/projects/emtest/lisp/viewers/old-231ewoc.el /home/tehom/projects/emtest/lisp/viewers/231ewoc.el
*** /home/tehom/projects/emtest/lisp/viewers/old-231ewoc.el	2009-12-09 17:37:21.000000000 -0500
--- /home/tehom/projects/emtest/lisp/viewers/231ewoc.el	2009-12-10 20:01:13.000000000 -0500
***************
*** 134,151 ****
        (setq n (1- n)))
      (unless (eq dll node) node)))
  
- (defun ewoc-location (node)
-   "Return the start location of NODE."
-   (ewoc--node-start-marker node))
- 
  \f
  ;;; The ewoc data type
  
  (defstruct (ewoc
  	    (:constructor nil)
! 	    (:constructor ewoc--create (buffer pretty-printer dll))
  	    (:conc-name ewoc--))
!   buffer pretty-printer header footer dll last-node hf-pp)
  
  (defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
    "Execute FORMS with ewoc--buffer selected as current buffer,
--- 134,147 ----
        (setq n (1- n)))
      (unless (eq dll node) node)))
  
  \f
  ;;; The ewoc data type
  
  (defstruct (ewoc
  	    (:constructor nil)
! 	    (:constructor ewoc--create (buffer pretty-printer dll separator))
  	    (:conc-name ewoc--))
!   buffer pretty-printer header footer dll last-node hf-pp separator)
  
  (defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
    "Execute FORMS with ewoc--buffer selected as current buffer,
***************
*** 170,233 ****
  	      (eq node (ewoc--footer ewoc)))
      node))
  
! (defun ewoc--adjust (beg end node dll)
!   ;; "Manually reseat" markers for NODE and its successors (including footer
!   ;; and dll), in the case where they originally shared start position with
!   ;; BEG, to END.  BEG and END are buffer positions describing NODE's left
!   ;; neighbor.  This operation is functionally equivalent to temporarily
!   ;; setting these nodes' markers' insertion type to t around the pretty-print
!   ;; call that precedes the call to `ewoc--adjust', and then changing them back
!   ;; to nil.
!   (when (< beg end)
!     (let (m)
!       (while (and (= beg (setq m (ewoc--node-start-marker node)))
!                   ;; The "dummy" node `dll' actually holds the marker that
!                   ;; points to the end of the footer, so we check `dll'
!                   ;; *after* reseating the marker.
!                   (progn
!                     (set-marker m end)
!                     (not (eq dll node))))
!         (setq node (ewoc--node-right node))))))
  
! (defun ewoc--insert-new-node (node data pretty-printer dll)
    "Insert before NODE a new node for DATA, displayed by PRETTY-PRINTER.
  Fourth arg DLL -- from `(ewoc--dll EWOC)' -- is for internal purposes.
  Call PRETTY-PRINTER with point at NODE's start, thus pushing back
  NODE and leaving the new node's start there.  Return the new node."
    (save-excursion
!     (let ((elemnode (ewoc--node-create
!                      (copy-marker (ewoc--node-start-marker node)) data)))
!       (setf (ewoc--node-left  elemnode) (ewoc--node-left node)
!             (ewoc--node-right elemnode)                  node
!             (ewoc--node-right (ewoc--node-left node)) elemnode
!             (ewoc--node-left                   node)  elemnode)
!       (ewoc--refresh-node pretty-printer elemnode dll)
        elemnode)))
  
! (defun ewoc--refresh-node (pp node dll)
    "Redisplay the element represented by NODE using the pretty-printer PP."
!   (let ((inhibit-read-only t)
!         (m (ewoc--node-start-marker node))
!         (R (ewoc--node-right node)))
!     ;; First, remove the string from the buffer:
!     (delete-region m (ewoc--node-start-marker R))
!     ;; Calculate and insert the string.
!     (goto-char m)
!     (funcall pp (ewoc--node-data node))
!     (ewoc--adjust m (point) R dll)))
! 
! (defun ewoc--wrap (func)
!   (lexical-let ((ewoc--user-pp func))
!     (lambda (data)
!       (funcall ewoc--user-pp data)
!       (insert "\n"))))
  
  \f
  ;;; ===========================================================================
  ;;;                  Public members of the Ewoc package
  
  ;;;###autoload
! (defun ewoc-create (pretty-printer &optional header footer nosep)
    "Create an empty ewoc.
  
  The ewoc will be inserted in the current buffer at the current position.
--- 166,299 ----
  	      (eq node (ewoc--footer ewoc)))
      node))
  
! (defun ewoc--link-node-before (new-node node)
!    "Physically insert NEW-NODE before NODE."
!    (setf
!       (ewoc--node-left new-node)               (ewoc--node-left node)
!       (ewoc--node-right new-node)               node
!       (ewoc--node-right (ewoc--node-left node)) new-node      
!       (ewoc--node-left node)                    new-node))
  
! (defun ewoc--insert-new-node (ewoc node data pretty-printer)
    "Insert before NODE a new node for DATA, displayed by PRETTY-PRINTER.
  Fourth arg DLL -- from `(ewoc--dll EWOC)' -- is for internal purposes.
  Call PRETTY-PRINTER with point at NODE's start, thus pushing back
  NODE and leaving the new node's start there.  Return the new node."
    (save-excursion
!     (let ((elemnode (ewoc--node-create nil data)))
!        (ewoc--link-node-before elemnode node)
!        (goto-char (ewoc-location-safe node))
!        (ewoc--print-node ewoc elemnode pretty-printer)
        elemnode)))
  
! (defun ewoc--refresh-node (pp node ewoc)
    "Redisplay the element represented by NODE using the pretty-printer PP."
!    (save-excursion
!       (goto-char (ewoc-location-safe node))
!       (ewoc--delete-node-text node)
!       (ewoc--print-anew ewoc node pp)))
! 
! \f
! ;;; ===========================================================================
! ;;;                  Node location
! 
! (defun ewoc--next-printed-node (node)
!    "Return the next non-empty node after NODE."
!    ;;This loop will terminate because we set at least one
!    ;;start-marker in the ewoc when creating it.
!    (do
!       ((node-after 
! 	  (ewoc--node-right node) 
! 	  (ewoc--node-right node-after)))
!       (
! 	 (ewoc--node-start-marker node-after)
! 	 node-after)))
!    
! (defun ewoc--next-start-marker (node)
!    "Return the first start marker after NODE."
!    (ewoc--node-start-marker
!       (ewoc--next-printed-node node)))
! 
! (defun ewoc-location (node)
!    "Return the start location of NODE.
! If NODE is empty, return the start marker of the next non-empty node."
!    (or
!       (ewoc--node-start-marker node)
!       (ewoc--next-start-marker node)))
! 
! ;;A start-marker's insertion-type should already be `t', but some
! ;;callers want to be 100% sure it is, so this function exists.
! (defun ewoc-location-safe (node)
!    "Get NODE's start location.  
! Also set the start-marker's insertion type to `t' so that it will stay
! after any text inserted at that point."
! 
!    (let
!       ((next-start-marker (ewoc-location node)))
!       (set-marker-insertion-type next-start-marker t)
!       next-start-marker))
! 
! \f
! ;;; ===========================================================================
! ;;;                  Printing and unprinting
! 
! (defun ewoc--mark-node-empty (node)
!    "Mark NODE empty (but don't empty it, assume it was emptied)
! INTERNAL USE ONLY."
!    (let
!       ((start-marker (ewoc--node-start-marker node)))
!       (when start-marker
! 	 (set-marker start-marker nil)
! 	 (setf (ewoc--node-start-marker node) nil))))
! 
! (defun ewoc--delete-node-text (node)
!    "Delete a node's text and mark it empty."
!    (let
!       ((inhibit-read-only t)
! 	 (m (ewoc--node-start-marker node)))
!       (when m
! 	 (delete-region m (ewoc--next-start-marker node))
! 	 (ewoc--mark-node-empty node))))
! 
! (defun ewoc--print-anew (ewoc node pp)
!    "Print a node that was erased but not marked empty."
!    (ewoc--mark-node-empty node)
!    (ewoc--print-node ewoc node pp))
! 
!    
! (defun ewoc--print-node (ewoc node printer)
!    "Print NODE at point using PRINTER.
! Set NODE's start-marker accordingly."
!    ;;Only print if node is currently empty
!    (when (ewoc--node-start-marker node)
!       (error "ewoc--print-node called with a node that's already printed"))
! 
!    (let
!       (
! 	 (start-pos (point))
! 	 (inhibit-read-only t))
! 
!       (funcall printer (ewoc-data node))
!       (let
! 	 ((separator (ewoc--separator ewoc)))
! 	 (when separator (insert separator)))
! 
!       ;;Only set up this node as non-empty if it actually is
!       ;;non-empty.
!       (unless
! 	 (= start-pos (point))
! 	 ;;Set its start-marker to the position we started
! 	 ;;printing from.
! 	 (setf 
! 	    (ewoc--node-start-marker node)
! 	    (copy-marker start-pos t)))))
  
  \f
  ;;; ===========================================================================
  ;;;                  Public members of the Ewoc package
  
  ;;;###autoload
! (defun ewoc-create (pretty-printer &optional header footer separator)
    "Create an empty ewoc.
  
  The ewoc will be inserted in the current buffer at the current position.
***************
*** 249,259 ****
           (dll (progn (setf (ewoc--node-right dummy-node) dummy-node)
                       (setf (ewoc--node-left dummy-node) dummy-node)
                       dummy-node))
!          (wrap (if nosep 'identity 'ewoc--wrap))
           (new-ewoc (ewoc--create (current-buffer)
!                                  (funcall wrap pretty-printer)
!                                  dll))
!          (hf-pp (funcall wrap 'insert))
           (pos (point))
           head foot)
      (ewoc--set-buffer-bind-dll new-ewoc
--- 315,332 ----
           (dll (progn (setf (ewoc--node-right dummy-node) dummy-node)
                       (setf (ewoc--node-left dummy-node) dummy-node)
                       dummy-node))
! 	 (separator
! 	    (cond
! 	       ((null separator) "\n")
! 	       ((stringp separator)
! 		  (if (string= separator "") nil separator))
! 	       ;;Non-nil, non-string argument means empty separator
! 	       (t nil)))
           (new-ewoc (ewoc--create (current-buffer)
!                                  pretty-printer
!                                  dll
! 		      		 separator))
!          (hf-pp #'insert)
           (pos (point))
           head foot)
      (ewoc--set-buffer-bind-dll new-ewoc
***************
*** 261,268 ****
        (unless header (setq header ""))
        (unless footer (setq footer ""))
        (setf (ewoc--node-start-marker dll) (copy-marker pos)
!             foot (ewoc--insert-new-node  dll footer hf-pp dll)
!             head (ewoc--insert-new-node foot header hf-pp dll)
              (ewoc--hf-pp new-ewoc) hf-pp
              (ewoc--footer new-ewoc) foot
              (ewoc--header new-ewoc) head))
--- 334,341 ----
        (unless header (setq header ""))
        (unless footer (setq footer ""))
        (setf (ewoc--node-start-marker dll) (copy-marker pos)
!             foot (ewoc--insert-new-node new-ewoc  dll footer hf-pp)
!             head (ewoc--insert-new-node new-ewoc foot header hf-pp)
              (ewoc--hf-pp new-ewoc) hf-pp
              (ewoc--footer new-ewoc) foot
              (ewoc--header new-ewoc) head))
***************
*** 300,306 ****
    "Enter a new element DATA before NODE in EWOC.
  Return the new node."
    (ewoc--set-buffer-bind-dll ewoc
!     (ewoc--insert-new-node node data (ewoc--pretty-printer ewoc) dll)))
  
  (defun ewoc-next (ewoc node)
    "Return the node in EWOC that follows NODE.
--- 373,379 ----
    "Enter a new element DATA before NODE in EWOC.
  Return the new node."
     (ewoc--set-buffer-bind-dll ewoc
!       (ewoc--insert-new-node ewoc node data (ewoc--pretty-printer ewoc))))
  
  (defun ewoc-next (ewoc node)
    "Return the node in EWOC that follows NODE.
***************
*** 347,355 ****
      (save-excursion
        (while (not (eq node footer))
          (if (apply map-function (ewoc--node-data node) args)
!             (ewoc--refresh-node pp node dll))
          (setq node (ewoc--node-next dll node))))))
  
  (defun ewoc-delete (ewoc &rest nodes)
    "Delete NODES from EWOC."
    (ewoc--set-buffer-bind-dll-let* ewoc
--- 420,442 ----
      (save-excursion
        (while (not (eq node footer))
          (if (apply map-function (ewoc--node-data node) args)
!             (ewoc--refresh-node pp node ewoc))
          (setq node (ewoc--node-next dll node))))))
  
+ (defalias 'ewoc-foreach 'ewoc-map)
+ 
+ (defmacro ewoc-do (spec &rest body)
+    "Evaluate BODY repeatedly, with NAME bound successively to the data
+ of each element.
+ The element will be refreshed if BODY returns non-nil."
+    (destructuring-bind (name ewoc-form) spec
+       `(progn
+ 	  (ewoc-foreach
+ 	     #'(lambda (,name)
+ 		  ,@body)
+ 	     ,ewoc-form))))
+ 
+ 
  (defun ewoc-delete (ewoc &rest nodes)
    "Delete NODES from EWOC."
    (ewoc--set-buffer-bind-dll-let* ewoc
***************
*** 359,367 ****
        ;; set last-node to nil.
        (when (eq last node)
          (setf last nil (ewoc--last-node ewoc) nil))
!       (delete-region (ewoc--node-start-marker node)
!                      (ewoc--node-start-marker (ewoc--node-next dll node)))
!       (set-marker (ewoc--node-start-marker node) nil)
        (setf L (ewoc--node-left  node)
              R (ewoc--node-right node)
              ;; Link neighbors to each other.
--- 446,452 ----
        ;; set last-node to nil.
        (when (eq last node)
          (setf last nil (ewoc--last-node ewoc) nil))
!       (ewoc--delete-node-text node)
        (setf L (ewoc--node-left  node)
              R (ewoc--node-right node)
              ;; Link neighbors to each other.
***************
*** 381,388 ****
    (ewoc--set-buffer-bind-dll-let* ewoc
        ((node (ewoc--node-nth dll 1))
         (footer (ewoc--footer ewoc))
!        (goodbye nil)
!        (inhibit-read-only t))
      (while (not (eq node footer))
        (unless (apply predicate (ewoc--node-data node) args)
          (push node goodbye))
--- 466,472 ----
    (ewoc--set-buffer-bind-dll-let* ewoc
        ((node (ewoc--node-nth dll 1))
         (footer (ewoc--footer ewoc))
!        (goodbye nil))
      (while (not (eq node footer))
        (unless (apply predicate (ewoc--node-data node) args)
          (push node goodbye))
***************
*** 406,416 ****
        nil)
  
       ;; Before second elem?
!      ((< pos (ewoc--node-start-marker (ewoc--node-nth dll 2)))
        (ewoc--node-nth dll 1))
  
       ;; After one-before-last elem?
!      ((>= pos (ewoc--node-start-marker (ewoc--node-nth dll -2)))
        (ewoc--node-nth dll -2))
  
       ;; We now know that pos is within a elem.
--- 490,500 ----
        nil)
  
       ;; Before second elem?
! 	 ((< pos (ewoc-location (ewoc--node-nth dll 2)))
        (ewoc--node-nth dll 1))
  
       ;; After one-before-last elem?
! 	 ((>= pos (ewoc-location (ewoc--node-nth dll -2)))
        (ewoc--node-nth dll -2))
  
       ;; We now know that pos is within a elem.
***************
*** 418,439 ****
        ;; Make an educated guess about which of the three known
        ;; node'es (the first, the last, or GUESS) is nearest.
        (let* ((best-guess (ewoc--node-nth dll 1))
! 	     (distance (abs (- pos (ewoc--node-start-marker best-guess)))))
  	(when guess
! 	  (let ((d (abs (- pos (ewoc--node-start-marker guess)))))
  	    (when (< d distance)
  	      (setq distance d)
  	      (setq best-guess guess))))
  
  	(let* ((g (ewoc--node-nth dll -1))	;Check the last elem
! 	       (d (abs (- pos (ewoc--node-start-marker g)))))
  	  (when (< d distance)
  	    (setq distance d)
  	    (setq best-guess g)))
  
  	(when (ewoc--last-node ewoc)    ;Check "previous".
  	  (let* ((g (ewoc--last-node ewoc))
! 		 (d (abs (- pos (ewoc--node-start-marker g)))))
  	    (when (< d distance)
  	      (setq distance d)
  	      (setq best-guess g))))
--- 502,523 ----
        ;; Make an educated guess about which of the three known
        ;; node'es (the first, the last, or GUESS) is nearest.
        (let* ((best-guess (ewoc--node-nth dll 1))
! 	     (distance (abs (- pos (ewoc-location best-guess)))))
  	(when guess
! 	  (let ((d (abs (- pos (ewoc-location guess)))))
  	    (when (< d distance)
  	      (setq distance d)
  	      (setq best-guess guess))))
  
  	(let* ((g (ewoc--node-nth dll -1))	;Check the last elem
! 	       (d (abs (- pos (ewoc-location g)))))
  	  (when (< d distance)
  	    (setq distance d)
  	    (setq best-guess g)))
  
  	(when (ewoc--last-node ewoc)    ;Check "previous".
  	  (let* ((g (ewoc--last-node ewoc))
! 		 (d (abs (- pos (ewoc-location g)))))
  	    (when (< d distance)
  	      (setq distance d)
  	      (setq best-guess g))))
***************
*** 445,460 ****
  	(cond
  	 ;; Is pos after the guess?
  	 ((>= pos
! 	      (ewoc--node-start-marker best-guess))
  	  ;; Loop until we are exactly one node too far down...
! 	  (while (>= pos (ewoc--node-start-marker best-guess))
  	    (setq best-guess (ewoc--node-next dll best-guess)))
  	  ;; ...and return the previous node.
  	  (ewoc--node-prev dll best-guess))
  
  	 ;; Pos is before best-guess
  	 (t
! 	  (while (< pos (ewoc--node-start-marker best-guess))
  	    (setq best-guess (ewoc--node-prev dll best-guess)))
  	  best-guess)))))))
  
--- 529,544 ----
  	(cond
  	 ;; Is pos after the guess?
  	 ((>= pos
! 		      (ewoc-location best-guess))
  	  ;; Loop until we are exactly one node too far down...
! 		     (while (>= pos (ewoc-location best-guess))
  	    (setq best-guess (ewoc--node-next dll best-guess)))
  	  ;; ...and return the previous node.
  	  (ewoc--node-prev dll best-guess))
  
  	 ;; Pos is before best-guess
  	 (t
! 		     (while (< pos (ewoc-location best-guess))
  	    (setq best-guess (ewoc--node-prev dll best-guess)))
  	  best-guess)))))))
  
***************
*** 465,471 ****
        ((pp (ewoc--pretty-printer ewoc)))
      (save-excursion
        (dolist (node nodes)
!         (ewoc--refresh-node pp node dll)))))
  
  (defun ewoc-goto-prev (ewoc arg)
    "Move point to the ARGth previous element in EWOC.
--- 549,555 ----
        ((pp (ewoc--pretty-printer ewoc)))
      (save-excursion
        (dolist (node nodes)
!         (ewoc--refresh-node pp node ewoc)))))
  
  (defun ewoc-goto-prev (ewoc arg)
    "Move point to the ARGth previous element in EWOC.
***************
*** 475,481 ****
        ((node (ewoc-locate ewoc (point))))
      (when node
        ;; If we were past the last element, first jump to it.
!       (when (>= (point) (ewoc--node-start-marker (ewoc--node-right node)))
  	(setq arg (1- arg)))
        (while (and node (> arg 0))
  	(setq arg (1- arg))
--- 559,565 ----
        ((node (ewoc-locate ewoc (point))))
      (when node
        ;; If we were past the last element, first jump to it.
! 	 (when (>= (point) (ewoc-location (ewoc--node-right node)))
  	(setq arg (1- arg)))
        (while (and node (> arg 0))
  	(setq arg (1- arg))
***************
*** 501,507 ****
  (defun ewoc-goto-node (ewoc node)
    "Move point to NODE in EWOC."
    (ewoc--set-buffer-bind-dll ewoc
!     (goto-char (ewoc--node-start-marker node))
      (if goal-column (move-to-column goal-column))
      (setf (ewoc--last-node ewoc) node)))
  
--- 585,591 ----
  (defun ewoc-goto-node (ewoc node)
    "Move point to NODE in EWOC."
    (ewoc--set-buffer-bind-dll ewoc
!       (goto-char (ewoc-location node))
      (if goal-column (move-to-column goal-column))
      (setf (ewoc--last-node ewoc) node)))
  
***************
*** 513,529 ****
  number of elements needs to be refreshed."
    (ewoc--set-buffer-bind-dll-let* ewoc
        ((footer (ewoc--footer ewoc)))
!     (let ((inhibit-read-only t))
!       (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1))
! 		     (ewoc--node-start-marker footer))
!       (goto-char (ewoc--node-start-marker footer))
        (let ((pp (ewoc--pretty-printer ewoc))
!             (node (ewoc--node-nth dll 1)))
  	(while (not (eq node footer))
! 	  (set-marker (ewoc--node-start-marker node) (point))
! 	  (funcall pp (ewoc--node-data node))
  	  (setq node (ewoc--node-next dll node)))))
!     (set-marker (ewoc--node-start-marker footer) (point))))
  
  (defun ewoc-collect (ewoc predicate &rest args)
    "Select elements from EWOC using PREDICATE.
--- 597,613 ----
  number of elements needs to be refreshed."
    (ewoc--set-buffer-bind-dll-let* ewoc
        ((footer (ewoc--footer ewoc)))
!     (let ((inhibit-read-only t)
! 	    (first-node (ewoc--node-nth dll 1)))
!       (delete-region (ewoc-location first-node)
! 		     (ewoc-location footer))
!       (goto-char (ewoc-location footer))
        (let ((pp (ewoc--pretty-printer ewoc))
!             (node first-node))
  	(while (not (eq node footer))
! 	   (ewoc--print-anew ewoc node pp)
  	  (setq node (ewoc--node-next dll node)))))
!     (set-marker (ewoc-location footer) (point))))
  
  (defun ewoc-collect (ewoc predicate &rest args)
    "Select elements from EWOC using PREDICATE.
***************
*** 567,576 ****
      (setf (ewoc--node-data head) header
            (ewoc--node-data foot) footer)
      (save-excursion
!       (ewoc--refresh-node hf-pp head dll)
!       (ewoc--refresh-node hf-pp foot dll))))
  
  \f
  (provide 'ewoc)
  
  ;; Local Variables:
--- 651,661 ----
      (setf (ewoc--node-data head) header
            (ewoc--node-data foot) footer)
      (save-excursion
!       (ewoc--refresh-node hf-pp head ewoc)
!       (ewoc--refresh-node hf-pp foot ewoc))))
  
  \f
+ (defconst ewoc-provides-variable-separator t)
  (provide 'ewoc)
  
  ;; Local Variables:

Diff finished at Thu Dec 10 20:17:19

[-- Attachment #3: testewoc.el --]
[-- Type: application/octet-stream, Size: 15456 bytes --]

;;;_ testewoc.el --- Testing for ewoc.el

;;;_. Headers
;;;_ , License
;; Copyright (C) 2009  Tom Breton (Tehom)

;; Author: Tom Breton (Tehom) <tehom@localhost.localdomain>
;; Keywords: maint, lisp

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;;_ , Commentary:

;; These tests require my package rtest, and in particular mockbuf.
;; However, rtest is in flux right now (and the new version will
;; depend on ewoc), so I'm afraid it's not easy to actually run these
;; tests right now.

;;The last test relies on TTN's colorcomp application.

;;;_ , Requires

(when (not (fboundp 'rtest:deftest))
    (defmacro rtest:deftest (&rest dummy))
    (defmacro rtest:if-avail (&rest dummy)))

;;;_. Body

;;;_ , Testing ewoc

;;;_  . Ewoc test support
;;;_   , ewoc-debug-get-position-skeleton

(defun ewoc-debug-get-position-skeleton (ewoc &optional func)
   "Return a list showing the position that each node starts at.
EWOC must be an ewoc.

FUNC must be nil or a function to call on each ewoc node (including
header and footer nodes). Its return value will be incorporated into
the return value. It can be used, for instance, to identify nodes."
   (ewoc--set-buffer-bind-dll ewoc
      (let 
	 ((func (or func #'ignore)))
	 (do ((node (ewoc--node-right dll) (ewoc--node-right node))
		(rv-output ()))
	    ((eq dll node) (nreverse rv-output)) 
	    (push
	       (list
		  (let
		     ((marker (ewoc--node-start-marker node)))
		     (when marker (marker-position marker)))
		  (funcall func (ewoc--node-data node)))
	       rv-output)))))

;;;_  . Tests
(rtest:deftest ewoc
   (  "Situation: newline separator, empty header & footer.
Demonstrates: Correct behavior of various parts of ewoc interface."
      (with-temp-buffer
	 (let
	    ((ewoc 
		(ewoc-create
		   #'insert nil nil))
	       (expected-contents
		  "
@
a
b
c
d

"
		  ))
	    
	    
	    (ewoc-enter-last ewoc "@")
	    (ewoc-enter-last ewoc "a")
	    (ewoc-enter-last ewoc "b")
	    (ewoc-enter-last ewoc "c")
	    (ewoc-enter-last ewoc "d")

	    ;;Validate
	    (assert
	       (mockbuf:buf-contents-matches
		  :string expected-contents))
      
	    ;;Check that nodes' data is as expected
	    (let* 
	       ((node (ewoc-nth ewoc 0)))
	       (assert
		  (equal (ewoc-data node) "@")
		  t))

	    (let* 
	       ((node (ewoc-nth ewoc 4)))
	       (assert
		  (equal (ewoc-data node) "d")
		  t))


	    ;;Test ewoc-location.  Since there's one element to a
	    ;;line, we need only test what line it's on and that it's
	    ;;at the beginning of the line.  `count-lines' needs +1 to
	    ;;account for the initial separator.  `goto-start-of-el'
	    ;;accounts for the separator and the fact that the top
	    ;;line = 1.
	    (labels
	       ((bolp/1 (pos)
		   (save-excursion
		      (goto-char pos)
		      (bolp)))
		  (assert-pos-matches-num (pos el-num)
		     (assert
			(bolp/1 pos)
			t)
		     (assert
			(= (1- (count-lines 1 pos)) el-num)
			t))
		  (assert-node-matches-num (node el-num)
		     (assert-pos-matches-num (ewoc-location node)
			el-num))
		  (goto-start-of-el (el-num) 
		     (goto-line (+ 2 el-num))))
	       
	       ;;ewoc-location
	       ;;First element
	       (let* 
		  ((node (ewoc-nth ewoc 0)))
		  (assert-node-matches-num node 0))
	    
	       ;;Last element
	       (let* 
		  ((node (ewoc-nth ewoc 4)))
		  (assert-node-matches-num node 4))
	    


	       ;;Test ewoc-locate

	       ;;Point at the beginning of an element, returns that
	       ;;element.  Because of the initial separator, `goto-line'
	       ;;needs to go to 1 + element number.
	       (goto-start-of-el 2)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "b")
		     t))
	    

	       ;;First node
	       (goto-start-of-el 0)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "@")
		     t))

	       ;;Last node
	       (goto-start-of-el 4)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "d")
		     t))

	       ;;After end
	       (goto-char (point-max))
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "d")
		     t))

	       ;;Before beginning
	       (goto-char 1)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "@")
		     t))


	       ;;Test ewoc-goto-prev
	       ;;4 - 1 to 3 
	       (goto-start-of-el 4)
	       (ewoc-goto-prev ewoc 1)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "c")
		     t))

	       ;;4 - 2 to 2
	       (goto-start-of-el 4)
	       (ewoc-goto-prev ewoc 2)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "b")
		     t))

	       ;;0 - 1 still at 0
	       (goto-start-of-el 0)
	       (ewoc-goto-prev ewoc 1)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "@")
		     t))
	    
	       ;;Test ewoc-goto-next
	       ;;2 + 1 to 3
	       (goto-start-of-el 2)
	       (ewoc-goto-next ewoc 1)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "c")
		     t))

	       ;;2 + 2 to 4
	       (goto-start-of-el 2)
	       (ewoc-goto-next ewoc 2)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "d")
		     t))

	       ;;4 + 1 still at 4
	       (goto-start-of-el 4)
	       (ewoc-goto-next ewoc 1)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "d")
		     t))
	       
	       ;;Test ewoc--refresh-node.
	       (emt:gives-error
		  (ewoc--refresh-node #'insert nil ewoc))
	       
	       ;;23.1 fails these tests.
	       (let* 
		  ((node (ewoc-nth ewoc 0)))
		  (ewoc--refresh-node #'insert node ewoc)
		  (assert
		     (mockbuf:buf-contents-matches
			:string expected-contents)))
	       (let* 
		  ((node (ewoc-nth ewoc 1)))
		  (ewoc--refresh-node #'insert node ewoc)
		  (assert
		     (mockbuf:buf-contents-matches
			:string expected-contents)))

	       (let* 
		  ((node (ewoc-nth ewoc 4)))
		  (ewoc--refresh-node #'insert node ewoc)
		  (assert
		     (mockbuf:buf-contents-matches
			:string expected-contents)))

	       ;;Test ewoc-refresh
	       (ewoc-refresh ewoc)
	       (assert
		  (mockbuf:buf-contents-matches
		     :string expected-contents
		     ))))
	 t))


   (  "Situation: no separator, empty header & footer.
Demonstrates: Correct behavior of various parts of ewoc interface."
      (with-temp-buffer
	 (let
	    ((ewoc 
		(ewoc-create #'insert nil nil ""))
	       (expected-contents
		  "@abcd"))
	    
	    (ewoc-enter-last ewoc "@")
	    (ewoc-enter-last ewoc "a")
	    (ewoc-enter-last ewoc "b")
	    (ewoc-enter-last ewoc "c")
	    (ewoc-enter-last ewoc "d")
	    
	    ;;Validate
	    (assert
	       (mockbuf:buf-contents-matches
		  :string expected-contents))

	    ;;Check that nodes' data is as expected
	    (let* 
	       ((node (ewoc-nth ewoc 0)))
	       (assert
		  (equal (ewoc-data node) "@")
		  t))

	    (let* 
	       ((node (ewoc-nth ewoc 4)))
	       (assert
		  (equal (ewoc-data node) "d")
		  t))


	    (labels
	       (
		  (assert-pos-matches-num (pos el-num)
		     (assert
			(= (1- pos) el-num)
			t))
		  (assert-node-matches-num (node el-num)
		     (assert-pos-matches-num (ewoc-location node)
			el-num))
		  (goto-start-of-el (el-num) 
		     (goto-char (1+ el-num))))
	       
	       ;;ewoc-location
	       ;;First element
	       (let* 
		  ((node (ewoc-nth ewoc 0)))
		  (assert-node-matches-num node 0))
	    
	       ;;Last element
	       (let* 
		  ((node (ewoc-nth ewoc 4)))
		  (assert-node-matches-num node 4))
	    


	       ;;Test ewoc-locate

	       ;;Point at the beginning of an element, returns that
	       ;;element.  Because of the initial separator, `goto-line'
	       ;;needs to go to 1 + element number.
	       (goto-start-of-el 2)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "b")
		     t))
	    

	       ;;First node
	       (goto-start-of-el 0)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "@")
		     t))

	       ;;Last node
	       (goto-start-of-el 4)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "d")
		     t))

	       ;;After end
	       (goto-char (point-max))
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "d")
		     t))

	       ;;Before beginning
	       (goto-char 1)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "@")
		     t))


	       ;;Test ewoc-goto-prev
	       ;;4 - 1 to 3 
	       (goto-start-of-el 4)
	       (ewoc-goto-prev ewoc 1)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "c")
		     t))

	       ;;4 - 2 to 2
	       (goto-start-of-el 4)
	       (ewoc-goto-prev ewoc 2)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "b")
		     t))

	       ;;0 - 1 still at 0
	       (goto-start-of-el 0)
	       (ewoc-goto-prev ewoc 1)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "@")
		     t))
	    
	       ;;Test ewoc-goto-next
	       ;;2 + 1 to 3
	       (goto-start-of-el 2)
	       (ewoc-goto-next ewoc 1)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "c")
		     t))

	       ;;2 + 2 to 4
	       (goto-start-of-el 2)
	       (ewoc-goto-next ewoc 2)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "d")
		     t))

	       ;;4 + 1 still at 4
	       (goto-start-of-el 4)
	       (ewoc-goto-next ewoc 1)
	       (let* 
		  ((node (ewoc-locate ewoc)))
		  (assert
		     (equal (ewoc-data node) "d")
		     t))
	       
	       ;;Test ewoc--refresh-node.
	       (emt:gives-error
		  (ewoc--refresh-node #'insert nil ewoc))
	       
	       (let* 
		  ((node (ewoc-nth ewoc 0)))
		  (ewoc--refresh-node #'insert node ewoc)
		  (assert
		     (mockbuf:buf-contents-matches
			:string expected-contents)))
	       (let* 
		  ((node (ewoc-nth ewoc 1)))
		  (ewoc--refresh-node #'insert node ewoc)
		  (assert
		     (mockbuf:buf-contents-matches
			:string expected-contents)))

	       (let* 
		  ((node (ewoc-nth ewoc 4)))
		  (ewoc--refresh-node #'insert node ewoc)
		  (assert
		     (mockbuf:buf-contents-matches
			:string expected-contents)))

	       ;;Test ewoc-refresh
	       (ewoc-refresh ewoc)
	       (assert
		  (mockbuf:buf-contents-matches
		     :string expected-contents
		     ))))
	 t))

   (  "Param: non-nil, non-string separator argument.
Response:  Behaves as the empty separator."
      (with-temp-buffer
	 (let
	    ((ewoc 
		(ewoc-create #'insert nil nil t))
	       (expected-contents
		  "@abcd"))
	    
	    (ewoc-enter-last ewoc "@")
	    (ewoc-enter-last ewoc "a")
	    (ewoc-enter-last ewoc "b")
	    (ewoc-enter-last ewoc "c")
	    (ewoc-enter-last ewoc "d")
	    
	    (assert
	       (mockbuf:buf-contents-matches
		  :string expected-contents)))

	 t))

      (  "Situation: no separator, empty header & footer, some empty elements.
Demonstrates: Correct behavior of refresh and map."
      (with-temp-buffer
	 (let
	    ((ewoc 
		(ewoc-create
		   #'insert nil nil ""))
	       (expected-contents
		  "ace"))
	    
	    (ewoc-enter-last ewoc "a")
	    (ewoc-enter-last ewoc "")
	    (ewoc-enter-last ewoc "c")
	    (ewoc-enter-last ewoc "")
	    (ewoc-enter-last ewoc "e")
	    
	    ;;Validate
	    (assert
	       (mockbuf:buf-contents-matches
		  :string expected-contents))

	    ;;Refresh

	    (ewoc-refresh ewoc)

	    (assert
	       (mockbuf:buf-contents-matches
		  :string expected-contents))

	    ;;Map

	    ;;All elements non-nil, ie reprinted.
	    (let
	       ((l
		   (ewoc-map #'identity ewoc)))
	       ;;`ewoc-map' doesn't actually collect a list of return
	       ;;values, so we can't test that.
	       )
	    
	    (assert
	       (mockbuf:buf-contents-matches
		  :string expected-contents))
	   
	    ;;One element non-nil, ie reprinted.
	    (ewoc-map #'string-equal
	       ewoc
	       "c")
	    (assert
	       (mockbuf:buf-contents-matches
		  :string expected-contents)))
	 
	 t))

   (  "Situation: no separator, empty header & footer, some empty elements.
Demonstrates: Correct behavior of filter."
      (with-temp-buffer
	 (let
	    ((ewoc 
		(ewoc-create
		   #'insert nil nil "")))
	    
	    (ewoc-enter-last ewoc "a")
	    (ewoc-enter-last ewoc "b")
	    (ewoc-enter-last ewoc "")
	    (ewoc-enter-last ewoc "a")
	    (ewoc-enter-last ewoc "c")
	    (ewoc-enter-last ewoc "a")
	    (ewoc-enter-last ewoc "")
	    (ewoc-enter-last ewoc "d")
	    
	    ;;Validate
	    (assert
	       (mockbuf:buf-contents-matches
		  :string "abacad"))

	    (ewoc-filter ewoc
	       #'(lambda (data str)
		    (not (string-equal data str))
		    )
	       "a")
	    
	    (assert
	       (mockbuf:buf-contents-matches
		  :string "bcd"))

	    ;;Behavior of `ewoc-do'
	    (let
	       ((count 0))
	       (ewoc-do (i ewoc)
		  (incf count))
	       (assert (= count 5) t))
	    
	    (let
	       ((count 0))
	       (ewoc-do (i ewoc)
		  (when (not (string-equal i ""))
		     (incf count)))
	       (assert (= count 3) t)))
	 
	 t))
   
   
   (  "Demonstration: The colorcomp application."
      (let*
	 ((color "green")
	    (buf-name
	       ;;Hack: Since colorcomp doesn't tell us what buffer it
	       ;;made, first generate the buffer name the same way it
	       ;;does.  Later we'll find the buffer with this name.
	       (generate-new-buffer-name 
		  (format "originally: %s" color))))
	 ;;If `colorcomp' is not available, this test is dormant (not
	 ;;supported yet)
	 (require 'colorcomp)
	 
	 (colorcomp color)
	 (with-current-buffer (get-buffer buf-name)
	    (assert
	       (mockbuf:buf-contents-matches
		  :dir "../t/examples/ewoc/"
		  :file "colorcomp.1.txt"))

	    ;;Put it thru its paces and check that buffer text is
	    ;;correct.
	    (dotimes (i 32) (colorcomp-R-more))
	    (assert
	       (mockbuf:buf-contents-matches
		  :dir "../t/examples/ewoc/"
		  :file "colorcomp.2.txt"))

	    (dotimes (i 64) (colorcomp-B-more))
	    (assert
	       (mockbuf:buf-contents-matches
		  :dir "../t/examples/ewoc/"
		  :file "colorcomp.3.txt"))

	    (dotimes (i 15) (colorcomp-G-less))
	    (assert
	       (mockbuf:buf-contents-matches
		  :dir "../t/examples/ewoc/"
		  :file "colorcomp.4.txt"))

	    (colorcomp-copy-as-kill-and-exit))
	 t))
   
   )


;;;_. Footers
;;;_ , Provides

(provide 'testewoc)

;;;_ * Local emacs vars.
;;;_  + Local variables:
;;;_  + mode: allout
;;;_  + End:

;;;_ , End
;;; testewoc.el ends here

Re: ewoc patch

[Stefan Monnier]

> Anyways, I have replaced the version variable with a variable called
> `ewoc-provides-variable-separator' that is bound just if ewoc provides
> a variable separator.  I hope that will satisfy.

That's what features are for, then.  Try C-h f `provide', you could
simply use the subfeature argument.

Anyway, I'm leaving for the other hemisphere, so it may take a while for
me to review the patch,


        Stefan

Re: ewoc patch

[Stefan Monnier]

[-- Attachment #1: Type: text/plain, Size: 1852 bytes --]

[ Sorry for the long delay. ]

Could you remind me of the purpose of this change?
Was it only to add a `separator' argument to ewoc?

While, I'm here I noticed that your code did not follow our indentation
and layout conventions, so I've fixed that in the attached patch (where
I also replaced the ewoc-provides-variable-separator with a subfeature).

Finally, regarding this comment:

   ;; A start-marker's insertion-type should already be `t', but some
   ;; callers want to be 100% sure it is, so this function exists.

is it the case that it would be a bug if the insertion-type was
changed to nil, or are there legitimate cases where the insertion-type
is changed to nil (and if so, which are these)?  I ask because if
there's no legitimate case, then we should just `assert' it.


        Stefan


>>>>> "Tom" == Tom Breton (Tehom) <tehom@panix.com> writes:

>> Keep only `separator', but with the added twist that a non-string,
>> non-nil argument means the empty string (aka mean "nosep").  That should
>> preserve backward compatibility with a mostly clean API.

> Done.

>> I think you're worrying for no good reason.  If you really want to
>> handle version dependencies right, you don't want it in a Lisp variable
>> but in a header understood and processed by some package manager (ELPA,
>> for instace).  Otherwise, you'll have to deal (one way or another) with
>> runtime checks, and in most cases the calling package will simply not
>> work with an older version.

> Yes, I have to deal with runtime checks.

> Anyways, I have replaced the version variable with a variable called
> `ewoc-provides-variable-separator' that is bound just if ewoc provides
> a variable separator.  I hope that will satisfy.

> Attached is
>  * new ewoc patch against 23.1
>  * test file

> Thank you for your help, Stefan.

>         Tom Breton (Tehom)



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: ewoc.diff --]
[-- Type: text/x-diff, Size: 11299 bytes --]

--- lisp/emacs-lisp/ewoc.el	2010-08-21 12:39:33.000000000 +0200
+++ ../trunk/lisp/emacs-lisp/ewoc.el	2010-08-21 12:49:41.000000000 +0200
@@ -139,7 +139,8 @@
 
 (defstruct (ewoc
 	    (:constructor nil)
-	    (:constructor ewoc--create (buffer pretty-printer dll separator))
+	    (:constructor ewoc--create (buffer pretty-printer dll
+                                               &optional separator))
 	    (:conc-name ewoc--))
   buffer pretty-printer header footer dll last-node hf-pp separator)
 
@@ -167,12 +168,12 @@
     node))
 
 (defun ewoc--link-node-before (new-node node)
-   "Physically insert NEW-NODE before NODE."
-   (setf
-      (ewoc--node-left new-node)               (ewoc--node-left node)
-      (ewoc--node-right new-node)               node
-      (ewoc--node-right (ewoc--node-left node)) new-node      
-      (ewoc--node-left node)                    new-node))
+  "Physically insert NEW-NODE before NODE."
+  (setf
+   (ewoc--node-left new-node)                (ewoc--node-left node)
+   (ewoc--node-right new-node)               node
+   (ewoc--node-right (ewoc--node-left node)) new-node
+   (ewoc--node-left node)                    new-node))
 
 (defun ewoc--insert-new-node (ewoc node data pretty-printer)
   "Insert before NODE a new node for DATA, displayed by PRETTY-PRINTER.
@@ -181,112 +182,99 @@
 NODE and leaving the new node's start there.  Return the new node."
   (save-excursion
     (let ((elemnode (ewoc--node-create nil data)))
-       (ewoc--link-node-before elemnode node)
-       (goto-char (ewoc-location-safe node))
-       (ewoc--print-node ewoc elemnode pretty-printer)
+      (ewoc--link-node-before elemnode node)
+      (goto-char (ewoc-location-safe node))
+      (ewoc--print-node ewoc elemnode pretty-printer)
       elemnode)))
 
 (defun ewoc--refresh-node (pp node ewoc)
   "Redisplay the element represented by NODE using the pretty-printer PP."
-   (save-excursion
-      (goto-char (ewoc-location-safe node))
-      (ewoc--delete-node-text node)
-      (ewoc--print-anew ewoc node pp)))
+  (save-excursion
+    (goto-char (ewoc-location-safe node))
+    (ewoc--delete-node-text node)
+    (ewoc--print-anew ewoc node pp)))
 
 \f
 ;;; ===========================================================================
 ;;;                  Node location
 
 (defun ewoc--next-printed-node (node)
-   "Return the next non-empty node after NODE."
-   ;;This loop will terminate because we set at least one
-   ;;start-marker in the ewoc when creating it.
-   (do
-      ((node-after 
-	  (ewoc--node-right node) 
-	  (ewoc--node-right node-after)))
-      (
-	 (ewoc--node-start-marker node-after)
-	 node-after)))
-   
+  "Return the next non-empty node after NODE."
+  ;; This loop will terminate because we set at least one
+  ;; start-marker in the ewoc when creating it.
+  (do ((node-after
+        (ewoc--node-right node)
+        (ewoc--node-right node-after)))
+      ((ewoc--node-start-marker node-after)
+       node-after)))
+
 (defun ewoc--next-start-marker (node)
-   "Return the first start marker after NODE."
-   (ewoc--node-start-marker
-      (ewoc--next-printed-node node)))
+  "Return the first start marker after NODE."
+  (ewoc--node-start-marker
+   (ewoc--next-printed-node node)))
 
 (defun ewoc-location (node)
-   "Return the start location of NODE.
+  "Return the start location of NODE.
 If NODE is empty, return the start marker of the next non-empty node."
-   (or
-      (ewoc--node-start-marker node)
+  (or (ewoc--node-start-marker node)
       (ewoc--next-start-marker node)))
 
-;;A start-marker's insertion-type should already be `t', but some
-;;callers want to be 100% sure it is, so this function exists.
+;; A start-marker's insertion-type should already be `t', but some
+;; callers want to be 100% sure it is, so this function exists.
 (defun ewoc-location-safe (node)
-   "Get NODE's start location.  
+  "Get NODE's start location.
 Also set the start-marker's insertion type to `t' so that it will stay
 after any text inserted at that point."
-
-   (let
-      ((next-start-marker (ewoc-location node)))
-      (set-marker-insertion-type next-start-marker t)
-      next-start-marker))
+  (let ((next-start-marker (ewoc-location node)))
+    (set-marker-insertion-type next-start-marker t)
+    next-start-marker))
 
 \f
 ;;; ===========================================================================
 ;;;                  Printing and unprinting
 
 (defun ewoc--mark-node-empty (node)
-   "Mark NODE empty (but don't empty it, assume it was emptied)
+  "Mark NODE empty (but don't empty it, assume it was emptied)
 INTERNAL USE ONLY."
-   (let
-      ((start-marker (ewoc--node-start-marker node)))
-      (when start-marker
-	 (set-marker start-marker nil)
-	 (setf (ewoc--node-start-marker node) nil))))
+  (let ((start-marker (ewoc--node-start-marker node)))
+    (when start-marker
+      (set-marker start-marker nil)
+      (setf (ewoc--node-start-marker node) nil))))
 
 (defun ewoc--delete-node-text (node)
-   "Delete a node's text and mark it empty."
-   (let
-      ((inhibit-read-only t)
-	 (m (ewoc--node-start-marker node)))
-      (when m
-	 (delete-region m (ewoc--next-start-marker node))
-	 (ewoc--mark-node-empty node))))
+  "Delete a node's text and mark it empty."
+  (let ((inhibit-read-only t)
+        (m (ewoc--node-start-marker node)))
+    (when m
+      (delete-region m (ewoc--next-start-marker node))
+      (ewoc--mark-node-empty node))))
 
 (defun ewoc--print-anew (ewoc node pp)
-   "Print a node that was erased but not marked empty."
-   (ewoc--mark-node-empty node)
-   (ewoc--print-node ewoc node pp))
+  "Print a node that was erased but not marked empty."
+  (ewoc--mark-node-empty node)
+  (ewoc--print-node ewoc node pp))
+
 
-   
 (defun ewoc--print-node (ewoc node printer)
-   "Print NODE at point using PRINTER.
+  "Print NODE at point using PRINTER.
 Set NODE's start-marker accordingly."
-   ;;Only print if node is currently empty
-   (when (ewoc--node-start-marker node)
-      (error "ewoc--print-node called with a node that's already printed"))
-
-   (let
-      (
-	 (start-pos (point))
-	 (inhibit-read-only t))
-
-      (funcall printer (ewoc-data node))
-      (let
-	 ((separator (ewoc--separator ewoc)))
-	 (when separator (insert separator)))
-
-      ;;Only set up this node as non-empty if it actually is
-      ;;non-empty.
-      (unless
-	 (= start-pos (point))
-	 ;;Set its start-marker to the position we started
-	 ;;printing from.
-	 (setf 
-	    (ewoc--node-start-marker node)
-	    (copy-marker start-pos t)))))
+  ;; Only print if node is currently empty.
+  (when (ewoc--node-start-marker node)
+    (error "ewoc--print-node called with a node that's already printed"))
+
+  (let ((start-pos (point))
+        (inhibit-read-only t))
+
+    (funcall printer (ewoc-data node))
+    (let ((separator (ewoc--separator ewoc)))
+      (when separator (insert separator)))
+
+    ;; Only set up this node as non-empty if it actually is non-empty.
+    (unless (= start-pos (point))
+      ;; Set its start-marker to the position we started printing from.
+      (setf
+       (ewoc--node-start-marker node)
+       (copy-marker start-pos t)))))
 
 \f
 ;;; ===========================================================================
@@ -316,12 +304,12 @@
                      (setf (ewoc--node-left dummy-node) dummy-node)
                      dummy-node))
 	 (separator
-	    (cond
-	       ((null separator) "\n")
-	       ((stringp separator)
-		  (if (string= separator "") nil separator))
-	       ;;Non-nil, non-string argument means empty separator
-	       (t nil)))
+          (cond
+           ((null separator) "\n")
+           ((stringp separator)
+            (if (string= separator "") nil separator))
+           ;;Non-nil, non-string argument means empty separator
+           (t nil)))
          (new-ewoc (ewoc--create (current-buffer)
                                  pretty-printer
                                  dll
@@ -426,15 +414,15 @@
 (defalias 'ewoc-foreach 'ewoc-map)
 
 (defmacro ewoc-do (spec &rest body)
-   "Evaluate BODY repeatedly, with NAME bound successively to the data
+  "Evaluate BODY repeatedly, with NAME bound successively to the data
 of each element.
 The element will be refreshed if BODY returns non-nil."
-   (destructuring-bind (name ewoc-form) spec
-      `(progn
-	  (ewoc-foreach
-	     #'(lambda (,name)
-		  ,@body)
-	     ,ewoc-form))))
+  (destructuring-bind (name ewoc-form) spec
+    `(progn
+       (ewoc-foreach
+        #'(lambda (,name)
+            ,@body)
+        ,ewoc-form))))
 
 
 (defun ewoc-delete (ewoc &rest nodes)
@@ -490,11 +478,11 @@
       nil)
 
      ;; Before second elem?
-	 ((< pos (ewoc-location (ewoc--node-nth dll 2)))
+     ((< pos (ewoc-location (ewoc--node-nth dll 2)))
       (ewoc--node-nth dll 1))
 
      ;; After one-before-last elem?
-	 ((>= pos (ewoc-location (ewoc--node-nth dll -2)))
+     ((>= pos (ewoc-location (ewoc--node-nth dll -2)))
       (ewoc--node-nth dll -2))
 
      ;; We now know that pos is within a elem.
@@ -529,16 +517,16 @@
 	(cond
 	 ;; Is pos after the guess?
 	 ((>= pos
-		      (ewoc-location best-guess))
+              (ewoc-location best-guess))
 	  ;; Loop until we are exactly one node too far down...
-		     (while (>= pos (ewoc-location best-guess))
+          (while (>= pos (ewoc-location best-guess))
 	    (setq best-guess (ewoc--node-next dll best-guess)))
 	  ;; ...and return the previous node.
 	  (ewoc--node-prev dll best-guess))
 
 	 ;; Pos is before best-guess
 	 (t
-		     (while (< pos (ewoc-location best-guess))
+          (while (< pos (ewoc-location best-guess))
 	    (setq best-guess (ewoc--node-prev dll best-guess)))
 	  best-guess)))))))
 
@@ -559,7 +547,7 @@
       ((node (ewoc-locate ewoc (point))))
     (when node
       ;; If we were past the last element, first jump to it.
-	 (when (>= (point) (ewoc-location (ewoc--node-right node)))
+      (when (>= (point) (ewoc-location (ewoc--node-right node)))
 	(setq arg (1- arg)))
       (while (and node (> arg 0))
 	(setq arg (1- arg))
@@ -585,7 +573,7 @@
 (defun ewoc-goto-node (ewoc node)
   "Move point to NODE in EWOC."
   (ewoc--set-buffer-bind-dll ewoc
-      (goto-char (ewoc-location node))
+    (goto-char (ewoc-location node))
     (if goal-column (move-to-column goal-column))
     (setf (ewoc--last-node ewoc) node)))
 
@@ -598,14 +586,14 @@
   (ewoc--set-buffer-bind-dll-let* ewoc
       ((footer (ewoc--footer ewoc)))
     (let ((inhibit-read-only t)
-	    (first-node (ewoc--node-nth dll 1)))
+          (first-node (ewoc--node-nth dll 1)))
       (delete-region (ewoc-location first-node)
 		     (ewoc-location footer))
       (goto-char (ewoc-location footer))
       (let ((pp (ewoc--pretty-printer ewoc))
             (node first-node))
 	(while (not (eq node footer))
-	   (ewoc--print-anew ewoc node pp)
+          (ewoc--print-anew ewoc node pp)
 	  (setq node (ewoc--node-next dll node)))))
     (set-marker (ewoc-location footer) (point))))
 
@@ -655,8 +643,7 @@
       (ewoc--refresh-node hf-pp foot ewoc))))
 
 \f
-(defconst ewoc-provides-variable-separator t)
-(provide 'ewoc)
+(provide 'ewoc '(separator))
 
 ;; Local Variables:
 ;; eval: (put 'ewoc--set-buffer-bind-dll 'lisp-indent-hook 1)