From: "Tom Breton (Tehom)" <tehom@panix.com>
To: "Stefan Monnier" <monnier@iro.umontreal.ca>
Cc: emacs-devel@gnu.org
Subject: Re: ewoc patch
Date: Thu, 10 Dec 2009 20:23:16 -0500 [thread overview]
Message-ID: <eeb7185efda8ef7ff0d4b9f9f19eeeac.squirrel@mail.panix.com> (raw)
In-Reply-To: <jwvr5r38f7t.fsf-monnier+emacs@gnu.org>
[-- 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
next prev parent reply other threads:[~2009-12-11 1:23 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2009-12-09 4:03 ewoc patch Tom Breton (Tehom)
2009-12-09 4:19 ` ewoc patch (Was wrong patch, right one attached) Tom Breton (Tehom)
2009-12-09 4:40 ` ewoc patch Stefan Monnier
2009-12-09 20:57 ` Tom Breton (Tehom)
2009-12-09 21:25 ` Stefan Monnier
2009-12-10 4:52 ` Tom Breton (Tehom)
2009-12-10 7:28 ` Stefan Monnier
2009-12-11 1:23 ` Tom Breton (Tehom) [this message]
2009-12-11 5:09 ` Stefan Monnier
2010-08-21 10:52 ` Stefan Monnier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=eeb7185efda8ef7ff0d4b9f9f19eeeac.squirrel@mail.panix.com \
--to=tehom@panix.com \
--cc=emacs-devel@gnu.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).