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))
- 
  
  ;;; 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)))
  
  
  ;;; 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"))))
  
  
  ;;; ===========================================================================
  ;;;                  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)))
! 
! 
! ;;; ===========================================================================
! ;;;                  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))
! 
! 
! ;;; ===========================================================================
! ;;;                  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)))))
  
  
  ;;; ===========================================================================
  ;;;                  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))))
  
  
  (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))))
  
  
+ (defconst ewoc-provides-variable-separator t)
  (provide 'ewoc)
  
  ;; Local Variables:

Diff finished at Thu Dec 10 20:17:19
